From gitlab at gitlab.haskell.org Tue Sep 1 00:18:13 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 31 Aug 2020 20:18:13 -0400 Subject: [Git][ghc/ghc][ghc-9.0] Bignum: fix BigNat subtraction (#18604) Message-ID: <5f4d9345e9170_80b3f846a80919c100480ce@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: bf8bb9e7 by Sylvain Henry at 2020-08-31T13:49:08-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - 7 changed files: - libraries/ghc-bignum/src/GHC/Num/BigNat.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs - libraries/ghc-bignum/src/GHC/Num/WordArray.hs - + testsuite/tests/numeric/should_run/T18604.hs - + testsuite/tests/numeric/should_run/T18604.stdout - testsuite/tests/numeric/should_run/all.T Changes: ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat.hs ===================================== @@ -506,7 +506,7 @@ bigNatSubUnsafe a b let szA = wordArraySize# a in withNewWordArrayTrimed# szA \mwa s-> case inline bignat_sub mwa a b s of - (# s', 0# #) -> s' + (# s', 1# #) -> s' (# s', _ #) -> case raiseUnderflow of !_ -> s' -- see Note [ghc-bignum exceptions] in ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs ===================================== @@ -92,8 +92,8 @@ bignat_sub {-# INLINE bignat_sub #-} bignat_sub mwa wa wb s = case ioWord# (c_mpn_sub mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of - (# s', 0## #) -> (# s', 0# #) - (# s', _ #) -> (# s', 1# #) + (# s', 1## #) -> (# s', 0# #) -- overflow + (# s', _ #) -> (# s', 1# #) -- no overflow bignat_sub_word :: MutableWordArray# RealWorld @@ -104,8 +104,8 @@ bignat_sub_word {-# INLINE bignat_sub_word #-} bignat_sub_word mwa wa b s = case ioWord# (c_mpn_sub_1 mwa wa (wordArraySize# wa) b) s of - (# s', 0## #) -> (# s', 0# #) - (# s', _ #) -> (# s', 1# #) + (# s', 1## #) -> (# s', 0# #) -- overflow + (# s', _ #) -> (# s', 1# #) -- no overflow bignat_mul :: MutableWordArray# RealWorld ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs ===================================== @@ -127,17 +127,17 @@ bignat_sub_word mwa wa b = go b 0# !sz = wordArraySize# wa go carry i s | isTrue# (i >=# sz) - = (# s, carry `neWord#` 0## #) + = (# s, carry `eqWord#` 0## #) | 0## <- carry = case mwaArrayCopy# mwa i wa i (sz -# i) s of - s' -> (# s', 0# #) + s' -> (# s', 1# #) -- no overflow | True = case subWordC# (indexWordArray# wa i) carry of (# 0##, 0# #) | isTrue# (i ==# sz) -> case mwaShrink# mwa 1# s of - s' -> (# s', 0# #) + s' -> (# s', 1# #) -- no overflow (# l , c #) -> case mwaWrite# mwa i l s of s1 -> go (int2Word# c) (i +# 1#) s1 ===================================== libraries/ghc-bignum/src/GHC/Num/WordArray.hs ===================================== @@ -318,7 +318,7 @@ mwaAddInplaceWord# mwa i y s = case readWordArray# mwa i s of -- | Sub Word# inplace (at the specified offset) in the mwa with carry -- propagation. -- --- Return True# on overflow +-- Return False# on overflow mwaSubInplaceWord# :: MutableWordArray# d -> Int# @@ -328,9 +328,9 @@ mwaSubInplaceWord# mwaSubInplaceWord# mwa ii iw s1 = case mwaSize# mwa s1 of (# is, sz #) -> let - go _ 0## s = (# s, 0# #) -- no overflow + go _ 0## s = (# s, 1# #) -- no overflow go i y s - | isTrue# (i >=# sz) = (# s, 1# #) -- overflow + | isTrue# (i >=# sz) = (# s, 0# #) -- overflow | True = case readWordArray# mwa i s of (# s1, x #) -> let !(# l,h #) = subWordC# x y in case mwaWrite# mwa i l s1 of @@ -368,16 +368,16 @@ mwaTrimCompare k mwa wb s1 -- -- We don't trim the resulting array! -- --- Return True# on overflow. +-- Return False# on overflow. mwaSubInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> (# State# d, Bool# #) mwaSubInplaceArray mwa off wb = go (wordArraySize# wb -# 1#) where go i s - | isTrue# (i <# 0#) = (# s, 0# #) -- no overflow + | isTrue# (i <# 0#) = (# s, 1# #) -- no overflow | True = case mwaSubInplaceWord# mwa (off +# i) (indexWordArray# wb i) s of - (# s2, 0# #) -> go (i -# 1#) s2 - (# s2, _ #) -> (# s2, 1# #) -- overflow + (# s2, 1# #) -> go (i -# 1#) s2 + (# s2, _ #) -> (# s2, 0# #) -- overflow -- | Add array inplace (a the specified offset) in the mwa with carry propagation. -- @@ -398,19 +398,19 @@ mwaAddInplaceArray mwa off wb = go 0# 0## -- -- We don't trim the resulting array! -- --- Return True# on overflow. +-- Return False# on overflow. mwaSubInplaceMutableArray :: MutableWordArray# d -> Int# -> MutableWordArray# d -> State# d -> (# State# d, Bool# #) mwaSubInplaceMutableArray mwa off mwb s0 = case mwaSize# mwb s0 of (# s1, szB #) -> go (szB -# 1#) s1 where go i s - | isTrue# (i <# 0#) = (# s, 0# #) -- no overflow + | isTrue# (i <# 0#) = (# s, 1# #) -- no overflow | True = case readWordArray# mwb i s of (# s1, bi #) -> case mwaSubInplaceWord# mwa (off +# i) bi s1 of - (# s2, 0# #) -> go (i -# 1#) s2 - (# s2, _ #) -> (# s2, 1# #) -- overflow + (# s2, 1# #) -> go (i -# 1#) s2 + (# s2, _ #) -> (# s2, 0# #) -- overflow -- | Sub an array inplace and then trim zeroes -- ===================================== testsuite/tests/numeric/should_run/T18604.hs ===================================== @@ -0,0 +1,10 @@ +module Main (main) where + +import Numeric.Natural + +main :: IO () +main = print (n - s) + where + n, s :: Natural + n = 137503105969312982142385040956303729937425409769904987267247644890331944583201 + s = 370814112419299627365008243601943822482 ===================================== testsuite/tests/numeric/should_run/T18604.stdout ===================================== @@ -0,0 +1 @@ +137503105969312982142385040956303729937054595657485687639882636646730000760719 ===================================== testsuite/tests/numeric/should_run/all.T ===================================== @@ -73,3 +73,4 @@ test('T18359', normal, compile_and_run, ['']) test('T18499', normal, compile_and_run, ['']) test('T18509', normal, compile_and_run, ['']) test('T18515', normal, compile_and_run, ['']) +test('T18604', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf8bb9e7855f680d850dd3ba22af0402b6b2f6df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf8bb9e7855f680d850dd3ba22af0402b6b2f6df You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 02:59:21 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 22:59:21 -0400 Subject: [Git][ghc/ghc][master] base: Better error message on invalid getSystemTimerManager call Message-ID: <5f4db9099898b_80bf42e3d410051325@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - 1 changed file: - libraries/base/GHC/Event/Thread.hs Changes: ===================================== libraries/base/GHC/Event/Thread.hs ===================================== @@ -19,6 +19,7 @@ module GHC.Event.Thread import Control.Exception (finally, SomeException, toException) import Data.Foldable (forM_, mapM_, sequence_) import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.Maybe (fromMaybe) import Data.Tuple (snd) import Foreign.C.Error (eBADF, errnoToIOError) import Foreign.C.Types (CInt(..), CUInt(..)) @@ -213,8 +214,9 @@ ioManagerLock = unsafePerformIO $ do getSystemTimerManager :: IO TM.TimerManager getSystemTimerManager = do - Just mgr <- readIORef timerManager - return mgr + fromMaybe err `fmap` readIORef timerManager + where + err = error "GHC.Event.Thread.getSystemTimerManager: the TimerManager requires linking against the threaded runtime" foreign import ccall unsafe "getOrSetSystemTimerThreadEventManagerStore" getOrSetSystemTimerThreadEventManagerStore :: Ptr a -> IO (Ptr a) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/329f7cb958551f5b384e2765a823770150152da2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/329f7cb958551f5b384e2765a823770150152da2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 02:59:55 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 22:59:55 -0400 Subject: [Git][ghc/ghc][master] Add tests for #15617. Message-ID: <5f4db92bf0bbc_80bf077f4c1005381@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - 3 changed files: - testsuite/tests/ghc-e/should_run/Makefile - + testsuite/tests/ghc-e/should_run/T15617a.stdout - testsuite/tests/ghc-e/should_run/all.T Changes: ===================================== testsuite/tests/ghc-e/should_run/Makefile ===================================== @@ -45,3 +45,9 @@ T9905b: # Ensure that ghc -e does not output extra messages about GHCi configuration files T11478: '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -ghci-script T11478.script -e 3 + +T15617a: + '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -fobject-code -O2 -e "let a = show 5 in a" + +T15617b: + '$(TEST_HC)' $(TEST_HC_OPTS) -ignore-dot-ghci -fobject-code -O2 -e "a = show 5" ===================================== testsuite/tests/ghc-e/should_run/T15617a.stdout ===================================== @@ -0,0 +1 @@ +"5" ===================================== testsuite/tests/ghc-e/should_run/all.T ===================================== @@ -16,3 +16,5 @@ test('T9086', req_interp, makefile_test, ['T9086']) test('T9905', req_interp, makefile_test, ['T9905']) test('T9905b', req_interp, makefile_test, ['T9905b']) test('T11478', req_interp, makefile_test, ['T11478']) +test('T15617a', req_interp, makefile_test, ['T15617a']) +test('T15617b', req_interp, makefile_test, ['T15617b']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6d70a8ff6a6cd628738fec902fc984936105264 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f6d70a8ff6a6cd628738fec902fc984936105264 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:00:34 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:00:34 -0400 Subject: [Git][ghc/ghc][master] Add additional tests for #18172 (Followup MR 3543) Message-ID: <5f4db952106f8_80bf42e3d4100570c4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - 3 changed files: - testsuite/tests/deSugar/should_run/T18172.script - testsuite/tests/deSugar/should_run/T18172.stderr - testsuite/tests/deSugar/should_run/T18172.stdout Changes: ===================================== testsuite/tests/deSugar/should_run/T18172.script ===================================== @@ -20,3 +20,10 @@ ZipList [259] :: ZipList Word8 :l T18172.hs Wombat [4, 264, 10] + +[1..5]::[Int] +[5..2]::[Int] +[6..9]::[Integer] +[9..6]::[Integer] +[10..15]::[Word8] +[15..10]::[Word8] ===================================== testsuite/tests/deSugar/should_run/T18172.stderr ===================================== @@ -45,3 +45,12 @@ :22:12: warning: [-Woverflowed-literals (in -Wdefault)] Literal 264 is out of the Word8 range 0..255 + +:25:1: warning: [-Wempty-enumerations (in -Wdefault)] + Enumeration is empty + +:27:1: warning: [-Wempty-enumerations (in -Wdefault)] + Enumeration is empty + +:29:1: warning: [-Wempty-enumerations (in -Wdefault)] + Enumeration is empty ===================================== testsuite/tests/deSugar/should_run/T18172.stdout ===================================== @@ -12,3 +12,9 @@ ZipList {getZipList = [3]} [] [] Wombat [4,8,10] +[1,2,3,4,5] +[] +[6,7,8,9] +[] +[10,11,12,13,14,15] +[] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5969fd06ad4b4c31a8bdce51d35f9aa05594b49 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5969fd06ad4b4c31a8bdce51d35f9aa05594b49 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:01:10 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:01:10 -0400 Subject: [Git][ghc/ghc][master] Bump Win32 and process submodules Message-ID: <5f4db9761e93e_80bf42e3d41006006c@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2 changed files: - libraries/Win32 - libraries/process Changes: ===================================== libraries/Win32 ===================================== @@ -1 +1 @@ -Subproject commit ca5fbc12851b98a52f96a43ea19c54c9ecf0f9e3 +Subproject commit f059037820ce68c5f524b188496cab196d979950 ===================================== libraries/process ===================================== @@ -1 +1 @@ -Subproject commit cb1d1a6ead68f0e1b209277e79ec608980e9ac84 +Subproject commit 11afa0bb827d05ed535463235c5f1805e8992273 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe18b4825c3289089a65b7b16b25e9d216a5b0fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fe18b4825c3289089a65b7b16b25e9d216a5b0fd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:01:47 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:01:47 -0400 Subject: [Git][ghc/ghc][master] Hadrian: fix slow-validate flavour (#18586) Message-ID: <5f4db99b2ec42_80b3f848765c304100627fd@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 1 changed file: - hadrian/src/Settings/Flavours/Validate.hs Changes: ===================================== hadrian/src/Settings/Flavours/Validate.hs ===================================== @@ -42,5 +42,10 @@ slowValidateFlavour = werror $ validateFlavour slowValidateArgs :: Args slowValidateArgs = mconcat [ validateArgs - , notStage0 ? arg "-DDEBUG" + , sourceArgs SourceArgs + { hsCompiler = notStage0 ? arg "-DDEBUG" + , hsDefault = mempty + , hsLibrary = mempty + , hsGhc = mempty + } ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2da933084b766fc424b11f5b671574d4c7317134 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2da933084b766fc424b11f5b671574d4c7317134 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:02:23 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:02:23 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Update dominator code with fixes from the dom-lt package. Message-ID: <5f4db9bfdf9a6_80bda69b8810064273@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 1 changed file: - compiler/GHC/CmmToAsm/CFG/Dominators.hs Changes: ===================================== compiler/GHC/CmmToAsm/CFG/Dominators.hs ===================================== @@ -1,597 +1,563 @@ -{-# LANGUAGE RankNTypes, BangPatterns, FlexibleContexts, Strict #-} - -{- | - Module : Dominators - Copyright : (c) Matt Morrow 2009 - License : BSD3 - Maintainer : - Stability : experimental - Portability : portable - - Taken from the dom-lt package. - - The Lengauer-Tarjan graph dominators algorithm. - - \[1\] Lengauer, Tarjan, - /A Fast Algorithm for Finding Dominators in a Flowgraph/, 1979. - - \[2\] Muchnick, - /Advanced Compiler Design and Implementation/, 1997. - - \[3\] Brisk, Sarrafzadeh, - /Interference Graphs for Procedures in Static Single/ - /Information Form are Interval Graphs/, 2007. - - Originally taken from the dom-lt package. --} - -module GHC.CmmToAsm.CFG.Dominators ( - Node,Path,Edge - ,Graph,Rooted - ,idom,ipdom - ,domTree,pdomTree - ,dom,pdom - ,pddfs,rpddfs - ,fromAdj,fromEdges - ,toAdj,toEdges - ,asTree,asGraph - ,parents,ancestors -) where - -import GHC.Prelude - -import Data.Bifunctor -import Data.Tuple (swap) - -import Data.Tree -import Data.IntMap(IntMap) -import Data.IntSet(IntSet) -import qualified Data.IntMap.Strict as IM -import qualified Data.IntSet as IS - -import Control.Monad -import Control.Monad.ST.Strict - -import Data.Array.ST -import Data.Array.Base hiding ((!)) - -- (unsafeNewArray_ - -- ,unsafeWrite,unsafeRead - -- ,readArray,writeArray) - -import GHC.Utils.Misc (debugIsOn) - ------------------------------------------------------------------------------ - -type Node = Int -type Path = [Node] -type Edge = (Node,Node) -type Graph = IntMap IntSet -type Rooted = (Node, Graph) - ------------------------------------------------------------------------------ - --- | /Dominators/. --- Complexity as for @idom@ -dom :: Rooted -> [(Node, Path)] -dom = ancestors . domTree - --- | /Post-dominators/. --- Complexity as for @idom at . -pdom :: Rooted -> [(Node, Path)] -pdom = ancestors . pdomTree - --- | /Dominator tree/. --- Complexity as for @idom at . -domTree :: Rooted -> Tree Node -domTree a@(r,_) = - let is = filter ((/=r).fst) (idom a) - tg = fromEdges (fmap swap is) - in asTree (r,tg) - --- | /Post-dominator tree/. --- Complexity as for @idom at . -pdomTree :: Rooted -> Tree Node -pdomTree a@(r,_) = - let is = filter ((/=r).fst) (ipdom a) - tg = fromEdges (fmap swap is) - in asTree (r,tg) - --- | /Immediate dominators/. --- /O(|E|*alpha(|E|,|V|))/, where /alpha(m,n)/ is --- \"a functional inverse of Ackermann's function\". --- --- This Complexity bound assumes /O(1)/ indexing. Since we're --- using @IntMap@, it has an additional /lg |V|/ factor --- somewhere in there. I'm not sure where. -idom :: Rooted -> [(Node,Node)] -idom rg = runST (evalS idomM =<< initEnv (pruneReach rg)) - --- | /Immediate post-dominators/. --- Complexity as for @idom at . -ipdom :: Rooted -> [(Node,Node)] -ipdom rg = runST (evalS idomM =<< initEnv (pruneReach (second predG rg))) - ------------------------------------------------------------------------------ - --- | /Post-dominated depth-first search/. -pddfs :: Rooted -> [Node] -pddfs = reverse . rpddfs - --- | /Reverse post-dominated depth-first search/. -rpddfs :: Rooted -> [Node] -rpddfs = concat . levels . pdomTree - ------------------------------------------------------------------------------ - -type Dom s a = S s (Env s) a -type NodeSet = IntSet -type NodeMap a = IntMap a -data Env s = Env - {succE :: !Graph - ,predE :: !Graph - ,bucketE :: !Graph - ,dfsE :: {-# UNPACK #-}!Int - ,zeroE :: {-# UNPACK #-}!Node - ,rootE :: {-# UNPACK #-}!Node - ,labelE :: {-# UNPACK #-}!(Arr s Node) - ,parentE :: {-# UNPACK #-}!(Arr s Node) - ,ancestorE :: {-# UNPACK #-}!(Arr s Node) - ,childE :: {-# UNPACK #-}!(Arr s Node) - ,ndfsE :: {-# UNPACK #-}!(Arr s Node) - ,dfnE :: {-# UNPACK #-}!(Arr s Int) - ,sdnoE :: {-# UNPACK #-}!(Arr s Int) - ,sizeE :: {-# UNPACK #-}!(Arr s Int) - ,domE :: {-# UNPACK #-}!(Arr s Node) - ,rnE :: {-# UNPACK #-}!(Arr s Node)} - ------------------------------------------------------------------------------ - -idomM :: Dom s [(Node,Node)] -idomM = do - dfsDom =<< rootM - n <- gets dfsE - forM_ [n,n-1..1] (\i-> do - w <- ndfsM i - sw <- sdnoM w - ps <- predsM w - forM_ ps (\v-> do - u <- eval v - su <- sdnoM u - when (su < sw) - (store sdnoE w su)) - z <- ndfsM =<< sdnoM w - modify(\e->e{bucketE=IM.adjust - (w`IS.insert`) - z (bucketE e)}) - pw <- parentM w - link pw w - bps <- bucketM pw - forM_ bps (\v-> do - u <- eval v - su <- sdnoM u - sv <- sdnoM v - let dv = case su < sv of - True-> u - False-> pw - store domE v dv)) - forM_ [1..n] (\i-> do - w <- ndfsM i - j <- sdnoM w - z <- ndfsM j - dw <- domM w - when (dw /= z) - (do ddw <- domM dw - store domE w ddw)) - fromEnv - ------------------------------------------------------------------------------ - -eval :: Node -> Dom s Node -eval v = do - n0 <- zeroM - a <- ancestorM v - case a==n0 of - True-> labelM v - False-> do - compress v - a <- ancestorM v - l <- labelM v - la <- labelM a - sl <- sdnoM l - sla <- sdnoM la - case sl <= sla of - True-> return l - False-> return la - -compress :: Node -> Dom s () -compress v = do - n0 <- zeroM - a <- ancestorM v - aa <- ancestorM a - when (aa /= n0) (do - compress a - a <- ancestorM v - aa <- ancestorM a - l <- labelM v - la <- labelM a - sl <- sdnoM l - sla <- sdnoM la - when (sla < sl) - (store labelE v la) - store ancestorE v aa) - ------------------------------------------------------------------------------ - -link :: Node -> Node -> Dom s () -link v w = do - n0 <- zeroM - lw <- labelM w - slw <- sdnoM lw - let balance s = do - c <- childM s - lc <- labelM c - slc <- sdnoM lc - case slw < slc of - False-> return s - True-> do - zs <- sizeM s - zc <- sizeM c - cc <- childM c - zcc <- sizeM cc - case 2*zc <= zs+zcc of - True-> do - store ancestorE c s - store childE s cc - balance s - False-> do - store sizeE c zs - store ancestorE s c - balance c - s <- balance w - lw <- labelM w - zw <- sizeM w - store labelE s lw - store sizeE v . (+zw) =<< sizeM v - let follow s = do - when (s /= n0) (do - store ancestorE s v - follow =<< childM s) - zv <- sizeM v - follow =<< case zv < 2*zw of - False-> return s - True-> do - cv <- childM v - store childE v s - return cv - ------------------------------------------------------------------------------ - -dfsDom :: Node -> Dom s () -dfsDom i = do - _ <- go i - n0 <- zeroM - r <- rootM - store parentE r n0 - where go i = do - n <- nextM - store dfnE i n - store sdnoE i n - store ndfsE n i - store labelE i i - ss <- succsM i - forM_ ss (\j-> do - s <- sdnoM j - case s==0 of - False-> return() - True-> do - store parentE j i - go j) - ------------------------------------------------------------------------------ - -initEnv :: Rooted -> ST s (Env s) -initEnv (r0,g0) = do - let (g,rnmap) = renum 1 g0 - pred = predG g - r = rnmap IM.! r0 - n = IM.size g - ns = [0..n] - m = n+1 - - let bucket = IM.fromList - (zip ns (repeat mempty)) - - rna <- newI m - writes rna (fmap swap - (IM.toList rnmap)) - - doms <- newI m - sdno <- newI m - size <- newI m - parent <- newI m - ancestor <- newI m - child <- newI m - label <- newI m - ndfs <- newI m - dfn <- newI m - - forM_ [0..n] (doms.=0) - forM_ [0..n] (sdno.=0) - forM_ [1..n] (size.=1) - forM_ [0..n] (ancestor.=0) - forM_ [0..n] (child.=0) - - (doms.=r) r - (size.=0) 0 - (label.=0) 0 - - return (Env - {rnE = rna - ,dfsE = 0 - ,zeroE = 0 - ,rootE = r - ,labelE = label - ,parentE = parent - ,ancestorE = ancestor - ,childE = child - ,ndfsE = ndfs - ,dfnE = dfn - ,sdnoE = sdno - ,sizeE = size - ,succE = g - ,predE = pred - ,bucketE = bucket - ,domE = doms}) - -fromEnv :: Dom s [(Node,Node)] -fromEnv = do - dom <- gets domE - rn <- gets rnE - -- r <- gets rootE - (_,n) <- st (getBounds dom) - forM [1..n] (\i-> do - j <- st(rn!:i) - d <- st(dom!:i) - k <- st(rn!:d) - return (j,k)) - ------------------------------------------------------------------------------ - -zeroM :: Dom s Node -zeroM = gets zeroE -domM :: Node -> Dom s Node -domM = fetch domE -rootM :: Dom s Node -rootM = gets rootE -succsM :: Node -> Dom s [Node] -succsM i = gets (IS.toList . (! i) . succE) -predsM :: Node -> Dom s [Node] -predsM i = gets (IS.toList . (! i) . predE) -bucketM :: Node -> Dom s [Node] -bucketM i = gets (IS.toList . (! i) . bucketE) -sizeM :: Node -> Dom s Int -sizeM = fetch sizeE -sdnoM :: Node -> Dom s Int -sdnoM = fetch sdnoE --- dfnM :: Node -> Dom s Int --- dfnM = fetch dfnE -ndfsM :: Int -> Dom s Node -ndfsM = fetch ndfsE -childM :: Node -> Dom s Node -childM = fetch childE -ancestorM :: Node -> Dom s Node -ancestorM = fetch ancestorE -parentM :: Node -> Dom s Node -parentM = fetch parentE -labelM :: Node -> Dom s Node -labelM = fetch labelE -nextM :: Dom s Int -nextM = do - n <- gets dfsE - let n' = n+1 - modify(\e->e{dfsE=n'}) - return n' - ------------------------------------------------------------------------------ - -type A = STUArray -type Arr s a = A s Int a - -infixl 9 !: -infixr 2 .= - -(.=) :: (MArray (A s) a (ST s)) - => Arr s a -> a -> Int -> ST s () -(v .= x) i - | debugIsOn = writeArray v i x - | otherwise = unsafeWrite v i x - -(!:) :: (MArray (A s) a (ST s)) - => A s Int a -> Int -> ST s a -a !: i - | debugIsOn = do - o <- readArray a i - return $! o - | otherwise = do - o <- unsafeRead a i - return $! o - -new :: (MArray (A s) a (ST s)) - => Int -> ST s (Arr s a) -new n = unsafeNewArray_ (0,n-1) - -newI :: Int -> ST s (Arr s Int) -newI = new - --- newD :: Int -> ST s (Arr s Double) --- newD = new - --- dump :: (MArray (A s) a (ST s)) => Arr s a -> ST s [a] --- dump a = do --- (m,n) <- getBounds a --- forM [m..n] (\i -> a!:i) - -writes :: (MArray (A s) a (ST s)) - => Arr s a -> [(Int,a)] -> ST s () -writes a xs = forM_ xs (\(i,x) -> (a.=x) i) - --- arr :: (MArray (A s) a (ST s)) => [a] -> ST s (Arr s a) --- arr xs = do --- let n = length xs --- a <- new n --- go a n 0 xs --- return a --- where go _ _ _ [] = return () --- go a n i (x:xs) --- | i <= n = (a.=x) i >> go a n (i+1) xs --- | otherwise = return () - ------------------------------------------------------------------------------ - -(!) :: Monoid a => IntMap a -> Int -> a -(!) g n = maybe mempty id (IM.lookup n g) - -fromAdj :: [(Node, [Node])] -> Graph -fromAdj = IM.fromList . fmap (second IS.fromList) - -fromEdges :: [Edge] -> Graph -fromEdges = collectI IS.union fst (IS.singleton . snd) - -toAdj :: Graph -> [(Node, [Node])] -toAdj = fmap (second IS.toList) . IM.toList - -toEdges :: Graph -> [Edge] -toEdges = concatMap (uncurry (fmap . (,))) . toAdj - -predG :: Graph -> Graph -predG g = IM.unionWith IS.union (go g) g0 - where g0 = fmap (const mempty) g - f :: IntMap IntSet -> Int -> IntSet -> IntMap IntSet - f m i a = foldl' (\m p -> IM.insertWith mappend p - (IS.singleton i) m) - m - (IS.toList a) - go :: IntMap IntSet -> IntMap IntSet - go = flip IM.foldlWithKey' mempty f - -pruneReach :: Rooted -> Rooted -pruneReach (r,g) = (r,g2) - where is = reachable - (maybe mempty id - . flip IM.lookup g) $ r - g2 = IM.fromList - . fmap (second (IS.filter (`IS.member`is))) - . filter ((`IS.member`is) . fst) - . IM.toList $ g - -tip :: Tree a -> (a, [Tree a]) -tip (Node a ts) = (a, ts) - -parents :: Tree a -> [(a, a)] -parents (Node i xs) = p i xs - ++ concatMap parents xs - where p i = fmap (flip (,) i . rootLabel) - -ancestors :: Tree a -> [(a, [a])] -ancestors = go [] - where go acc (Node i xs) - = let acc' = i:acc - in p acc' xs ++ concatMap (go acc') xs - p is = fmap (flip (,) is . rootLabel) - -asGraph :: Tree Node -> Rooted -asGraph t@(Node a _) = let g = go t in (a, fromAdj g) - where go (Node a ts) = let as = (fst . unzip . fmap tip) ts - in (a, as) : concatMap go ts - -asTree :: Rooted -> Tree Node -asTree (r,g) = let go a = Node a (fmap go ((IS.toList . f) a)) - f = (g !) - in go r - -reachable :: (Node -> NodeSet) -> (Node -> NodeSet) -reachable f a = go (IS.singleton a) a - where go seen a = let s = f a - as = IS.toList (s `IS.difference` seen) - in foldl' go (s `IS.union` seen) as - -collectI :: (c -> c -> c) - -> (a -> Int) -> (a -> c) -> [a] -> IntMap c -collectI (<>) f g - = foldl' (\m a -> IM.insertWith (<>) - (f a) - (g a) m) mempty - --- collect :: (Ord b) => (c -> c -> c) --- -> (a -> b) -> (a -> c) -> [a] -> Map b c --- collect (<>) f g --- = foldl' (\m a -> SM.insertWith (<>) --- (f a) --- (g a) m) mempty - --- (renamed, old -> new) -renum :: Int -> Graph -> (Graph, NodeMap Node) -renum from = (\(_,m,g)->(g,m)) - . IM.foldlWithKey' - f (from,mempty,mempty) - where - f :: (Int, NodeMap Node, IntMap IntSet) -> Node -> IntSet - -> (Int, NodeMap Node, IntMap IntSet) - f (!n,!env,!new) i ss = - let (j,n2,env2) = go n env i - (n3,env3,ss2) = IS.fold - (\k (!n,!env,!new)-> - case go n env k of - (l,n2,env2)-> (n2,env2,l `IS.insert` new)) - (n2,env2,mempty) ss - new2 = IM.insertWith IS.union j ss2 new - in (n3,env3,new2) - go :: Int - -> NodeMap Node - -> Node - -> (Node,Int,NodeMap Node) - go !n !env i = - case IM.lookup i env of - Just j -> (j,n,env) - Nothing -> (n,n+1,IM.insert i n env) - ------------------------------------------------------------------------------ - -newtype S z s a = S {unS :: forall o. (a -> s -> ST z o) -> s -> ST z o} -instance Functor (S z s) where - fmap f (S g) = S (\k -> g (k . f)) -instance Monad (S z s) where - return = pure - S g >>= f = S (\k -> g (\a -> unS (f a) k)) -instance Applicative (S z s) where - pure a = S (\k -> k a) - (<*>) = ap --- get :: S z s s --- get = S (\k s -> k s s) -gets :: (s -> a) -> S z s a -gets f = S (\k s -> k (f s) s) --- set :: s -> S z s () --- set s = S (\k _ -> k () s) -modify :: (s -> s) -> S z s () -modify f = S (\k -> k () . f) --- runS :: S z s a -> s -> ST z (a, s) --- runS (S g) = g (\a s -> return (a,s)) -evalS :: S z s a -> s -> ST z a -evalS (S g) = g ((return .) . const) --- execS :: S z s a -> s -> ST z s --- execS (S g) = g ((return .) . flip const) -st :: ST z a -> S z s a -st m = S (\k s-> do - a <- m - k a s) -store :: (MArray (A z) a (ST z)) - => (s -> Arr z a) -> Int -> a -> S z s () -store f i x = do - a <- gets f - st ((a.=x) i) -fetch :: (MArray (A z) a (ST z)) - => (s -> Arr z a) -> Int -> S z s a -fetch f i = do - a <- gets f - st (a!:i) - +{-# LANGUAGE RankNTypes, BangPatterns, FlexibleContexts, Strict #-} + +{- | + Module : GHC.CmmToAsm.CFG.Dominators + Copyright : (c) Matt Morrow 2009 + License : BSD3 + Maintainer : + Stability : stable + Portability : portable + + The Lengauer-Tarjan graph dominators algorithm. + + \[1\] Lengauer, Tarjan, + /A Fast Algorithm for Finding Dominators in a Flowgraph/, 1979. + + \[2\] Muchnick, + /Advanced Compiler Design and Implementation/, 1997. + + \[3\] Brisk, Sarrafzadeh, + /Interference Graphs for Procedures in Static Single/ + /Information Form are Interval Graphs/, 2007. + + * Strictness + + Unless stated otherwise all exposed functions might fully evaluate their input + but are not guaranteed to do so. + +-} + +module GHC.CmmToAsm.CFG.Dominators ( + Node,Path,Edge + ,Graph,Rooted + ,idom,ipdom + ,domTree,pdomTree + ,dom,pdom + ,pddfs,rpddfs + ,fromAdj,fromEdges + ,toAdj,toEdges + ,asTree,asGraph + ,parents,ancestors +) where + +import GHC.Prelude +import Data.Bifunctor +import Data.Tuple (swap) + +import Data.Tree +import Data.IntMap(IntMap) +import Data.IntSet(IntSet) +import qualified Data.IntMap.Strict as IM +import qualified Data.IntSet as IS + +import Control.Monad +import Control.Monad.ST.Strict + +import Data.Array.ST +import Data.Array.Base + (unsafeNewArray_ + ,unsafeWrite,unsafeRead) + +----------------------------------------------------------------------------- + +type Node = Int +type Path = [Node] +type Edge = (Node,Node) +type Graph = IntMap IntSet +type Rooted = (Node, Graph) + +----------------------------------------------------------------------------- + +-- | /Dominators/. +-- Complexity as for @idom@ +dom :: Rooted -> [(Node, Path)] +dom = ancestors . domTree + +-- | /Post-dominators/. +-- Complexity as for @idom at . +pdom :: Rooted -> [(Node, Path)] +pdom = ancestors . pdomTree + +-- | /Dominator tree/. +-- Complexity as for @idom at . +domTree :: Rooted -> Tree Node +domTree a@(r,_) = + let is = filter ((/=r).fst) (idom a) + tg = fromEdges (fmap swap is) + in asTree (r,tg) + +-- | /Post-dominator tree/. +-- Complexity as for @idom at . +pdomTree :: Rooted -> Tree Node +pdomTree a@(r,_) = + let is = filter ((/=r).fst) (ipdom a) + tg = fromEdges (fmap swap is) + in asTree (r,tg) + +-- | /Immediate dominators/. +-- /O(|E|*alpha(|E|,|V|))/, where /alpha(m,n)/ is +-- \"a functional inverse of Ackermann's function\". +-- +-- This Complexity bound assumes /O(1)/ indexing. Since we're +-- using @IntMap@, it has an additional /lg |V|/ factor +-- somewhere in there. I'm not sure where. +idom :: Rooted -> [(Node,Node)] +idom rg = runST (evalS idomM =<< initEnv (pruneReach rg)) + +-- | /Immediate post-dominators/. +-- Complexity as for @idom at . +ipdom :: Rooted -> [(Node,Node)] +ipdom rg = runST (evalS idomM =<< initEnv (pruneReach (second predG rg))) + +----------------------------------------------------------------------------- + +-- | /Post-dominated depth-first search/. +pddfs :: Rooted -> [Node] +pddfs = reverse . rpddfs + +-- | /Reverse post-dominated depth-first search/. +rpddfs :: Rooted -> [Node] +rpddfs = concat . levels . pdomTree + +----------------------------------------------------------------------------- + +type Dom s a = S s (Env s) a +type NodeSet = IntSet +type NodeMap a = IntMap a +data Env s = Env + {succE :: !Graph + ,predE :: !Graph + ,bucketE :: !Graph + ,dfsE :: {-# UNPACK #-}!Int + ,zeroE :: {-# UNPACK #-}!Node + ,rootE :: {-# UNPACK #-}!Node + ,labelE :: {-# UNPACK #-}!(Arr s Node) + ,parentE :: {-# UNPACK #-}!(Arr s Node) + ,ancestorE :: {-# UNPACK #-}!(Arr s Node) + ,childE :: {-# UNPACK #-}!(Arr s Node) + ,ndfsE :: {-# UNPACK #-}!(Arr s Node) + ,dfnE :: {-# UNPACK #-}!(Arr s Int) + ,sdnoE :: {-# UNPACK #-}!(Arr s Int) + ,sizeE :: {-# UNPACK #-}!(Arr s Int) + ,domE :: {-# UNPACK #-}!(Arr s Node) + ,rnE :: {-# UNPACK #-}!(Arr s Node)} + +----------------------------------------------------------------------------- + +idomM :: Dom s [(Node,Node)] +idomM = do + dfsDom =<< rootM + n <- gets dfsE + forM_ [n,n-1..1] (\i-> do + w <- ndfsM i + ps <- predsM w + forM_ ps (\v-> do + sw <- sdnoM w + u <- eval v + su <- sdnoM u + when (su < sw) + (store sdnoE w su)) + z <- ndfsM =<< sdnoM w + modify(\e->e{bucketE=IM.adjust + (w`IS.insert`) + z (bucketE e)}) + pw <- parentM w + link pw w + bps <- bucketM pw + forM_ bps (\v-> do + u <- eval v + su <- sdnoM u + sv <- sdnoM v + let dv = case su < sv of + True-> u + False-> pw + store domE v dv)) + forM_ [1..n] (\i-> do + w <- ndfsM i + j <- sdnoM w + z <- ndfsM j + dw <- domM w + when (dw /= z) + (do ddw <- domM dw + store domE w ddw)) + fromEnv + +----------------------------------------------------------------------------- + +eval :: Node -> Dom s Node +eval v = do + n0 <- zeroM + a <- ancestorM v + case a==n0 of + True-> labelM v + False-> do + compress v + a <- ancestorM v + l <- labelM v + la <- labelM a + sl <- sdnoM l + sla <- sdnoM la + case sl <= sla of + True-> return l + False-> return la + +compress :: Node -> Dom s () +compress v = do + n0 <- zeroM + a <- ancestorM v + aa <- ancestorM a + when (aa /= n0) (do + compress a + a <- ancestorM v + aa <- ancestorM a + l <- labelM v + la <- labelM a + sl <- sdnoM l + sla <- sdnoM la + when (sla < sl) + (store labelE v la) + store ancestorE v aa) + +----------------------------------------------------------------------------- + +link :: Node -> Node -> Dom s () +link v w = do + n0 <- zeroM + lw <- labelM w + slw <- sdnoM lw + let balance s = do + c <- childM s + lc <- labelM c + slc <- sdnoM lc + case slw < slc of + False-> return s + True-> do + zs <- sizeM s + zc <- sizeM c + cc <- childM c + zcc <- sizeM cc + case 2*zc <= zs+zcc of + True-> do + store ancestorE c s + store childE s cc + balance s + False-> do + store sizeE c zs + store ancestorE s c + balance c + s <- balance w + lw <- labelM w + zw <- sizeM w + store labelE s lw + store sizeE v . (+zw) =<< sizeM v + let follow s = do + when (s /= n0) (do + store ancestorE s v + follow =<< childM s) + zv <- sizeM v + follow =<< case zv < 2*zw of + False-> return s + True-> do + cv <- childM v + store childE v s + return cv + +----------------------------------------------------------------------------- + +dfsDom :: Node -> Dom s () +dfsDom i = do + _ <- go i + n0 <- zeroM + r <- rootM + store parentE r n0 + where go i = do + n <- nextM + store dfnE i n + store sdnoE i n + store ndfsE n i + store labelE i i + ss <- succsM i + forM_ ss (\j-> do + s <- sdnoM j + case s==0 of + False-> return() + True-> do + store parentE j i + go j) + +----------------------------------------------------------------------------- + +initEnv :: Rooted -> ST s (Env s) +initEnv (r0,g0) = do + -- Graph renumbered to indices from 1 to |V| + let (g,rnmap) = renum 1 g0 + pred = predG g -- reverse graph + root = rnmap IM.! r0 -- renamed root + n = IM.size g + ns = [0..n] + m = n+1 + + let bucket = IM.fromList + (zip ns (repeat mempty)) + + rna <- newI m + writes rna (fmap swap + (IM.toList rnmap)) + + doms <- newI m + sdno <- newI m + size <- newI m + parent <- newI m + ancestor <- newI m + child <- newI m + label <- newI m + ndfs <- newI m + dfn <- newI m + + -- Initialize all arrays + forM_ [0..n] (doms.=0) + forM_ [0..n] (sdno.=0) + forM_ [1..n] (size.=1) + forM_ [0..n] (ancestor.=0) + forM_ [0..n] (child.=0) + + (doms.=root) root + (size.=0) 0 + (label.=0) 0 + + return (Env + {rnE = rna + ,dfsE = 0 + ,zeroE = 0 + ,rootE = root + ,labelE = label + ,parentE = parent + ,ancestorE = ancestor + ,childE = child + ,ndfsE = ndfs + ,dfnE = dfn + ,sdnoE = sdno + ,sizeE = size + ,succE = g + ,predE = pred + ,bucketE = bucket + ,domE = doms}) + +fromEnv :: Dom s [(Node,Node)] +fromEnv = do + dom <- gets domE + rn <- gets rnE + -- r <- gets rootE + (_,n) <- st (getBounds dom) + forM [1..n] (\i-> do + j <- st(rn!:i) + d <- st(dom!:i) + k <- st(rn!:d) + return (j,k)) + +----------------------------------------------------------------------------- + +zeroM :: Dom s Node +zeroM = gets zeroE +domM :: Node -> Dom s Node +domM = fetch domE +rootM :: Dom s Node +rootM = gets rootE +succsM :: Node -> Dom s [Node] +succsM i = gets (IS.toList . (! i) . succE) +predsM :: Node -> Dom s [Node] +predsM i = gets (IS.toList . (! i) . predE) +bucketM :: Node -> Dom s [Node] +bucketM i = gets (IS.toList . (! i) . bucketE) +sizeM :: Node -> Dom s Int +sizeM = fetch sizeE +sdnoM :: Node -> Dom s Int +sdnoM = fetch sdnoE +-- dfnM :: Node -> Dom s Int +-- dfnM = fetch dfnE +ndfsM :: Int -> Dom s Node +ndfsM = fetch ndfsE +childM :: Node -> Dom s Node +childM = fetch childE +ancestorM :: Node -> Dom s Node +ancestorM = fetch ancestorE +parentM :: Node -> Dom s Node +parentM = fetch parentE +labelM :: Node -> Dom s Node +labelM = fetch labelE +nextM :: Dom s Int +nextM = do + n <- gets dfsE + let n' = n+1 + modify(\e->e{dfsE=n'}) + return n' + +----------------------------------------------------------------------------- + +type A = STUArray +type Arr s a = A s Int a + +infixl 9 !: +infixr 2 .= + +-- | arr .= x idx => write x to index +(.=) :: (MArray (A s) a (ST s)) + => Arr s a -> a -> Int -> ST s () +(v .= x) i = unsafeWrite v i x + +(!:) :: (MArray (A s) a (ST s)) + => A s Int a -> Int -> ST s a +a !: i = do + o <- unsafeRead a i + return $! o + +new :: (MArray (A s) a (ST s)) + => Int -> ST s (Arr s a) +new n = unsafeNewArray_ (0,n-1) + +newI :: Int -> ST s (Arr s Int) +newI = new + +writes :: (MArray (A s) a (ST s)) + => Arr s a -> [(Int,a)] -> ST s () +writes a xs = forM_ xs (\(i,x) -> (a.=x) i) + + +(!) :: Monoid a => IntMap a -> Int -> a +(!) g n = maybe mempty id (IM.lookup n g) + +fromAdj :: [(Node, [Node])] -> Graph +fromAdj = IM.fromList . fmap (second IS.fromList) + +fromEdges :: [Edge] -> Graph +fromEdges = collectI IS.union fst (IS.singleton . snd) + +toAdj :: Graph -> [(Node, [Node])] +toAdj = fmap (second IS.toList) . IM.toList + +toEdges :: Graph -> [Edge] +toEdges = concatMap (uncurry (fmap . (,))) . toAdj + +predG :: Graph -> Graph +predG g = IM.unionWith IS.union (go g) g0 + where g0 = fmap (const mempty) g + go = flip IM.foldrWithKey mempty (\i a m -> + foldl' (\m p -> IM.insertWith mappend p + (IS.singleton i) m) + m + (IS.toList a)) + +pruneReach :: Rooted -> Rooted +pruneReach (r,g) = (r,g2) + where is = reachable + (maybe mempty id + . flip IM.lookup g) $ r + g2 = IM.fromList + . fmap (second (IS.filter (`IS.member`is))) + . filter ((`IS.member`is) . fst) + . IM.toList $ g + +tip :: Tree a -> (a, [Tree a]) +tip (Node a ts) = (a, ts) + +parents :: Tree a -> [(a, a)] +parents (Node i xs) = p i xs + ++ concatMap parents xs + where p i = fmap (flip (,) i . rootLabel) + +ancestors :: Tree a -> [(a, [a])] +ancestors = go [] + where go acc (Node i xs) + = let acc' = i:acc + in p acc' xs ++ concatMap (go acc') xs + p is = fmap (flip (,) is . rootLabel) + +asGraph :: Tree Node -> Rooted +asGraph t@(Node a _) = let g = go t in (a, fromAdj g) + where go (Node a ts) = let as = (fst . unzip . fmap tip) ts + in (a, as) : concatMap go ts + +asTree :: Rooted -> Tree Node +asTree (r,g) = let go a = Node a (fmap go ((IS.toList . f) a)) + f = (g !) + in go r + +reachable :: (Node -> NodeSet) -> (Node -> NodeSet) +reachable f a = go (IS.singleton a) a + where go seen a = let s = f a + as = IS.toList (s `IS.difference` seen) + in foldl' go (s `IS.union` seen) as + +collectI :: (c -> c -> c) + -> (a -> Int) -> (a -> c) -> [a] -> IntMap c +collectI (<>) f g + = foldl' (\m a -> IM.insertWith (<>) + (f a) + (g a) m) mempty + +-- | renum n g: Rename all nodes +-- +-- Gives nodes sequential names starting at n. +-- Returns the new graph and a mapping. +-- (renamed, old -> new) +renum :: Int -> Graph -> (Graph, NodeMap Node) +renum from = (\(_,m,g)->(g,m)) + . IM.foldrWithKey + (\i ss (!n,!env,!new)-> + let (j,n2,env2) = go n env i + (n3,env3,ss2) = IS.fold + (\k (!n,!env,!new)-> + case go n env k of + (l,n2,env2)-> (n2,env2,l `IS.insert` new)) + (n2,env2,mempty) ss + new2 = IM.insertWith IS.union j ss2 new + in (n3,env3,new2)) (from,mempty,mempty) + where go :: Int + -> NodeMap Node + -> Node + -> (Node,Int,NodeMap Node) + go !n !env i = + case IM.lookup i env of + Just j -> (j,n,env) + Nothing -> (n,n+1,IM.insert i n env) + +----------------------------------------------------------------------------- + +-- Nothing better than reinvinting the state monad. +newtype S z s a = S {unS :: forall o. (a -> s -> ST z o) -> s -> ST z o} +instance Functor (S z s) where + fmap f (S g) = S (\k -> g (k . f)) +instance Monad (S z s) where + return = pure + S g >>= f = S (\k -> g (\a -> unS (f a) k)) +instance Applicative (S z s) where + pure a = S (\k -> k a) + (<*>) = ap +-- get :: S z s s +-- get = S (\k s -> k s s) +gets :: (s -> a) -> S z s a +gets f = S (\k s -> k (f s) s) +-- set :: s -> S z s () +-- set s = S (\k _ -> k () s) +modify :: (s -> s) -> S z s () +modify f = S (\k -> k () . f) +-- runS :: S z s a -> s -> ST z (a, s) +-- runS (S g) = g (\a s -> return (a,s)) +evalS :: S z s a -> s -> ST z a +evalS (S g) = g ((return .) . const) +-- execS :: S z s a -> s -> ST z s +-- execS (S g) = g ((return .) . flip const) +st :: ST z a -> S z s a +st m = S (\k s-> do + a <- m + k a s) +store :: (MArray (A z) a (ST z)) + => (s -> Arr z a) -> Int -> a -> S z s () +store f i x = do + a <- gets f + st ((a.=x) i) +fetch :: (MArray (A z) a (ST z)) + => (s -> Arr z a) -> Int -> S z s a +fetch f i = do + a <- gets f + st (a!:i) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2da933084b766fc424b11f5b671574d4c7317134...dffb38fab00ac1cd1cbc75156abcf373976581f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2da933084b766fc424b11f5b671574d4c7317134...dffb38fab00ac1cd1cbc75156abcf373976581f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:02:56 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:02:56 -0400 Subject: [Git][ghc/ghc][master] [fixup 3433] move debugBelch into IF_DEBUG(linker) Message-ID: <5f4db9e02117a_80b3f849bd62130100675eb@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - 1 changed file: - rts/linker/Elf.c Changes: ===================================== rts/linker/Elf.c ===================================== @@ -903,8 +903,9 @@ ocGetNames_ELF ( ObjectCode* oc ) common_used += symbol->elf_sym->st_size; ASSERT(common_used <= common_size); - debugBelch("COMMON symbol, size %ld name %s allocated at %p\n", - symbol->elf_sym->st_size, nm, symbol->addr); + IF_DEBUG(linker, + debugBelch("COMMON symbol, size %ld name %s allocated at %p\n", + symbol->elf_sym->st_size, nm, symbol->addr)); /* Pointless to do addProddableBlock() for this area, since the linker should never poke around in it. */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6189cc04ca6c3d79126744e988b487f75ccef9e2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6189cc04ca6c3d79126744e988b487f75ccef9e2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:03:36 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:03:36 -0400 Subject: [Git][ghc/ghc][master] Don't store HomeUnit in UnitConfig Message-ID: <5f4dba08264a6_80b3f84514fdef810071098@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 1 changed file: - compiler/GHC/Unit/State.hs Changes: ===================================== compiler/GHC/Unit/State.hs ===================================== @@ -315,7 +315,12 @@ instance Monoid UnitVisibility where data UnitConfig = UnitConfig { unitConfigPlatformArchOS :: !ArchOS -- ^ Platform arch and OS , unitConfigWays :: !Ways -- ^ Ways to use - , unitConfigHomeUnit :: !HomeUnit -- ^ Home unit + + , unitConfigAllowVirtual :: !Bool -- ^ Allow virtual units + -- ^ Do we allow the use of virtual units instantiated on-the-fly (see Note + -- [About units] in GHC.Unit). This should only be true when we are + -- type-checking an indefinite unit (not producing any code). + , unitConfigProgramName :: !String -- ^ Name of the compiler (e.g. "GHC", "GHCJS"). Used to fetch environment -- variables such as "GHC[JS]_PACKAGE_PATH". @@ -344,18 +349,28 @@ data UnitConfig = UnitConfig initUnitConfig :: DynFlags -> UnitConfig initUnitConfig dflags = - let home_unit = mkHomeUnitFromFlags dflags + let !hu_id = homeUnitId_ dflags + !hu_instanceof = homeUnitInstanceOf_ dflags + !hu_instantiations = homeUnitInstantiations_ dflags + autoLink | not (gopt Opt_AutoLinkPackages dflags) = [] -- By default we add base & rts to the preload units (when they are -- found in the unit database) except when we are building them - | otherwise = filter (not . isHomeUnitId home_unit) [baseUnitId, rtsUnitId] + | otherwise = filter (hu_id /=) [baseUnitId, rtsUnitId] + + -- if the home unit is indefinite, it means we are type-checking it only + -- (not producing any code). Hence we can use virtual units instantiated + -- on-the-fly. See Note [About units] in GHC.Unit + allow_virtual_units = case (hu_instanceof, hu_instantiations) of + (Just u, is) -> u == hu_id && any (isHoleModule . snd) is + _ -> False in UnitConfig { unitConfigPlatformArchOS = platformArchOS (targetPlatform dflags) , unitConfigProgramName = programName dflags , unitConfigWays = ways dflags - , unitConfigHomeUnit = home_unit + , unitConfigAllowVirtual = allow_virtual_units , unitConfigGlobalDB = globalPackageDatabasePath dflags , unitConfigGHCDir = topDir dflags @@ -1624,24 +1639,14 @@ mkUnitState ctx printer cfg = do , wireMap = wired_map , unwireMap = Map.fromList [ (v,k) | (k,v) <- Map.toList wired_map ] , requirementContext = req_ctx - , allowVirtualUnits = unitConfigAllowVirtualUnits cfg + , allowVirtualUnits = unitConfigAllowVirtual cfg } return (state, raw_dbs) --- | Do we allow the use of virtual units instantiated on-the-fly (see Note --- [About units] in GHC.Unit). This should only be true when we are --- type-checking an indefinite unit (not producing any code). -unitConfigAllowVirtualUnits :: UnitConfig -> Bool -unitConfigAllowVirtualUnits cfg = - -- when the home unit is indefinite, it means we are type-checking it only - -- (not producing any code). Hence we can use virtual units instantiated - -- on-the-fly (see Note [About units] in GHC.Unit) - isHomeUnitIndefinite (unitConfigHomeUnit cfg) - -- | Given a wired-in 'Unit', "unwire" it into the 'Unit' -- that it was recorded as in the package database. -unwireUnit :: UnitState -> Unit-> Unit +unwireUnit :: UnitState -> Unit -> Unit unwireUnit state uid@(RealUnit (Definite def_uid)) = maybe uid (RealUnit . Definite) (Map.lookup def_uid (unwireMap state)) unwireUnit _ uid = uid @@ -1733,7 +1738,7 @@ mkModuleNameProvidersMap ctx cfg pkg_map closure vis_map = hiddens = [(m, mkModMap pk m ModHidden) | m <- hidden_mods] pk = mkUnit pkg - unit_lookup uid = lookupUnit' (unitConfigAllowVirtualUnits cfg) pkg_map closure uid + unit_lookup uid = lookupUnit' (unitConfigAllowVirtual cfg) pkg_map closure uid `orElse` pprPanic "unit_lookup" (ppr uid) exposed_mods = unitExposedModules pkg View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcb68a3f7f85b9fdef6f4845e608d086b01e6a58 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bcb68a3f7f85b9fdef6f4845e608d086b01e6a58 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:04:10 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:04:10 -0400 Subject: [Git][ghc/ghc][master] Fix documentation and fix "check" bignum backend (#18604) Message-ID: <5f4dba2ab6584_80b3f848765c30410072435@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - 5 changed files: - libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs - libraries/ghc-bignum/src/GHC/Num/WordArray.hs Changes: ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs ===================================== @@ -129,8 +129,8 @@ mwaCompareOpBool mwa f g s = 0# -> case unexpectedValue of !_ -> (# s, ra #) -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives - _ -> case (ra ==# 1#) of -- don't compare MWAs if overflow signaled! - 1# -> (# s, ra #) + _ -> case ra of -- don't compare MWAs if underflow signaled! + 0# -> (# s, ra #) -- underflow _ -> case mwaTrimZeroes# mwa s of { s -> case mwaTrimZeroes# mwb s of { s -> case mwaCompare mwa mwb s of ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs ===================================== @@ -113,7 +113,7 @@ foreign import ccall unsafe ghc_bignat_mul_word -- The potential 0 most-significant Words will be removed by the caller if it is -- not already done by the backend. -- --- Return True to indicate overflow. +-- Return False# to indicate underflow. bignat_sub :: MutableWordArray# RealWorld -> WordArray# @@ -136,7 +136,7 @@ foreign import ccall unsafe ghc_bignat_sub -- The potential 0 most-significant Words will be removed by the caller if it is -- not already done by the backend. -- --- Return True to indicate overflow. +-- Return False# to indicate underflow. bignat_sub_word :: MutableWordArray# RealWorld -> WordArray# ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs ===================================== @@ -92,8 +92,8 @@ bignat_sub {-# INLINE bignat_sub #-} bignat_sub mwa wa wb s = case ioWord# (c_mpn_sub mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of - (# s', 1## #) -> (# s', 0# #) -- overflow - (# s', _ #) -> (# s', 1# #) -- no overflow + (# s', 1## #) -> (# s', 0# #) -- underflow + (# s', _ #) -> (# s', 1# #) -- no underflow bignat_sub_word :: MutableWordArray# RealWorld @@ -104,8 +104,8 @@ bignat_sub_word {-# INLINE bignat_sub_word #-} bignat_sub_word mwa wa b s = case ioWord# (c_mpn_sub_1 mwa wa (wordArraySize# wa) b) s of - (# s', 1## #) -> (# s', 0# #) -- overflow - (# s', _ #) -> (# s', 1# #) -- no overflow + (# s', 1## #) -> (# s', 0# #) -- underflow + (# s', _ #) -> (# s', 1# #) -- no underflow bignat_mul :: MutableWordArray# RealWorld ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs ===================================== @@ -131,13 +131,13 @@ bignat_sub_word mwa wa b = go b 0# | 0## <- carry = case mwaArrayCopy# mwa i wa i (sz -# i) s of - s' -> (# s', 1# #) -- no overflow + s' -> (# s', 1# #) -- no underflow | True = case subWordC# (indexWordArray# wa i) carry of (# 0##, 0# #) | isTrue# (i ==# sz) -> case mwaShrink# mwa 1# s of - s' -> (# s', 1# #) -- no overflow + s' -> (# s', 1# #) -- no underflow (# l , c #) -> case mwaWrite# mwa i l s of s1 -> go (int2Word# c) (i +# 1#) s1 ===================================== libraries/ghc-bignum/src/GHC/Num/WordArray.hs ===================================== @@ -318,7 +318,7 @@ mwaAddInplaceWord# mwa i y s = case readWordArray# mwa i s of -- | Sub Word# inplace (at the specified offset) in the mwa with carry -- propagation. -- --- Return False# on overflow +-- Return False# on underflow mwaSubInplaceWord# :: MutableWordArray# d -> Int# @@ -328,9 +328,9 @@ mwaSubInplaceWord# mwaSubInplaceWord# mwa ii iw s1 = case mwaSize# mwa s1 of (# is, sz #) -> let - go _ 0## s = (# s, 1# #) -- no overflow + go _ 0## s = (# s, 1# #) -- no underflow go i y s - | isTrue# (i >=# sz) = (# s, 0# #) -- overflow + | isTrue# (i >=# sz) = (# s, 0# #) -- underflow | True = case readWordArray# mwa i s of (# s1, x #) -> let !(# l,h #) = subWordC# x y in case mwaWrite# mwa i l s1 of @@ -368,16 +368,16 @@ mwaTrimCompare k mwa wb s1 -- -- We don't trim the resulting array! -- --- Return False# on overflow. +-- Return False# on underflow. mwaSubInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> (# State# d, Bool# #) mwaSubInplaceArray mwa off wb = go (wordArraySize# wb -# 1#) where go i s - | isTrue# (i <# 0#) = (# s, 1# #) -- no overflow + | isTrue# (i <# 0#) = (# s, 1# #) -- no underflow | True = case mwaSubInplaceWord# mwa (off +# i) (indexWordArray# wb i) s of (# s2, 1# #) -> go (i -# 1#) s2 - (# s2, _ #) -> (# s2, 0# #) -- overflow + (# s2, _ #) -> (# s2, 0# #) -- underflow -- | Add array inplace (a the specified offset) in the mwa with carry propagation. -- @@ -398,19 +398,19 @@ mwaAddInplaceArray mwa off wb = go 0# 0## -- -- We don't trim the resulting array! -- --- Return False# on overflow. +-- Return False# on underflow. mwaSubInplaceMutableArray :: MutableWordArray# d -> Int# -> MutableWordArray# d -> State# d -> (# State# d, Bool# #) mwaSubInplaceMutableArray mwa off mwb s0 = case mwaSize# mwb s0 of (# s1, szB #) -> go (szB -# 1#) s1 where go i s - | isTrue# (i <# 0#) = (# s, 1# #) -- no overflow + | isTrue# (i <# 0#) = (# s, 1# #) -- no underflow | True = case readWordArray# mwb i s of (# s1, bi #) -> case mwaSubInplaceWord# mwa (off +# i) bi s1 of (# s2, 1# #) -> go (i -# 1#) s2 - (# s2, _ #) -> (# s2, 0# #) -- overflow + (# s2, _ #) -> (# s2, 0# #) -- underflow -- | Sub an array inplace and then trim zeroes -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a3723876c6c79a0a407d50f4baa2818a13f232e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a3723876c6c79a0a407d50f4baa2818a13f232e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:04:46 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:04:46 -0400 Subject: [Git][ghc/ghc][master] Set the dynamic-system-linker flag to Manual Message-ID: <5f4dba4e87d5a_80b3f84514fdef8100764f6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 1 changed file: - compiler/ghc.cabal.in Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -51,7 +51,7 @@ Flag terminfo Flag dynamic-system-linker Description: The system can load dynamic code. This is not the case for musl. Default: True - Manual: False + Manual: True Library Default-Language: Haskell2010 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb85f125a227f6b5703d4a2e997c5ea320dfa31f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb85f125a227f6b5703d4a2e997c5ea320dfa31f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:05:20 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:05:20 -0400 Subject: [Git][ghc/ghc][master] Ignore more files Message-ID: <5f4dba70a735f_80b3f849bd62130100793da@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 1 changed file: - .gitignore Changes: ===================================== .gitignore ===================================== @@ -78,6 +78,7 @@ _darcs/ /libffi/dist-install/ /libraries/*/dist-boot/ /libraries/*/dist-install/ +/libraries/*/dist-newstyle/ /libraries/dist-haddock/ /rts/dist/ /utils/*/dist*/ @@ -227,8 +228,14 @@ ghc.nix/ .gdb_history .gdbinit -# Tooling - direnv +# ----------------------------------------------------------------------------- +# Tooling + +# direnv .envrc -# Tooling - vscode +# Visual Studio Code .vscode + +# clangd +.clangd View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/380ef84587fb6890d100c338d1992a6994a4f02a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/380ef84587fb6890d100c338d1992a6994a4f02a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:05:56 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:05:56 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Limit upper version of Happy for ghc-9.0 and earlier (#18620) Message-ID: <5f4dba94b1707_80b1090a6401008082e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - 2 changed files: - aclocal.m4 - hadrian/hadrian.cabal Changes: ===================================== aclocal.m4 ===================================== @@ -1026,6 +1026,8 @@ if test ! -f compiler/GHC/Parser.hs || test ! -f compiler/GHC/Cmm/Parser.hs then FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-lt],[1.19.10], [AC_MSG_ERROR([Happy version 1.19.10 or later is required to compile GHC.])])[] + FP_COMPARE_VERSIONS([$fptools_cv_happy_version],[-ge],[1.21.0], + [AC_MSG_ERROR([Happy version 1.20 or earlier is required to compile GHC.])])[] fi HappyVersion=$fptools_cv_happy_version; AC_SUBST(HappyVersion) ===================================== hadrian/hadrian.cabal ===================================== @@ -148,7 +148,7 @@ executable hadrian , transformers >= 0.4 && < 0.6 , unordered-containers >= 0.2.1 && < 0.3 build-tools: alex >= 3.1 - , happy >= 1.19.10 + , happy >= 1.19.10 && < 1.21 ghc-options: -Wall -Wincomplete-record-updates -Wredundant-constraints View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/380ef84587fb6890d100c338d1992a6994a4f02a...a4473f02ae2e685601e257b8668bea2ec721b294 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/380ef84587fb6890d100c338d1992a6994a4f02a...a4473f02ae2e685601e257b8668bea2ec721b294 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 03:06:34 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 31 Aug 2020 23:06:34 -0400 Subject: [Git][ghc/ghc][master] Bignum: add BigNat compat functions (#18613) Message-ID: <5f4dbaba21dd0_80b1090a640100851b5@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 1 changed file: - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs Changes: ===================================== libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs ===================================== @@ -50,9 +50,22 @@ module GHC.Integer.GMP.Internals , zeroBigNat , oneBigNat + -- ** Conversions to/from 'BigNat' + + , wordToBigNat + , wordToBigNat2 + , bigNatToInt + , bigNatToWord + , indexBigNat# + , importBigNatFromByteArray + , exportBigNatToMutableByteArray + + -- ** 'BigNat' arithmetic operations , plusBigNat , plusBigNatWord + , minusBigNat + , minusBigNatWord , timesBigNat , timesBigNatWord , sqrBigNat @@ -112,6 +125,8 @@ import qualified GHC.Num.BigNat as B import qualified GHC.Num.Primitives as P import GHC.Types import GHC.Prim +import GHC.Exts (runRW#) +import Control.Exception {-# COMPLETE S#, Jp#, Jn# #-} @@ -199,6 +214,19 @@ plusBigNat (BN# a) (BN# b) = BN# (B.bigNatAdd a b) plusBigNatWord :: BigNat -> GmpLimb# -> BigNat plusBigNatWord (BN# a) w = BN# (B.bigNatAddWord# a w) +{-# DEPRECATED minusBigNat "Use bigNatSub instead" #-} +minusBigNat :: BigNat -> BigNat -> BigNat +minusBigNat (BN# a) (BN# b) = case B.bigNatSub a b of + (# () | #) -> throw Underflow + (# | r #) -> BN# r + +{-# DEPRECATED minusBigNatWord "Use bigNatSubWord# instead" #-} +minusBigNatWord :: BigNat -> GmpLimb# -> BigNat +minusBigNatWord (BN# a) b = case B.bigNatSubWord# a b of + (# () | #) -> throw Underflow + (# | r #) -> BN# r + + {-# DEPRECATED timesBigNat "Use bigNatMul instead" #-} timesBigNat :: BigNat -> BigNat -> BigNat timesBigNat (BN# a) (BN# b) = BN# (B.bigNatMul a b) @@ -344,3 +372,29 @@ exportBigNatToAddr :: BigNat -> Addr# -> Int# -> IO Word exportBigNatToAddr (BN# b) addr endian = IO \s -> case B.bigNatToAddr# b addr endian s of (# s', w #) -> (# s', W# w #) + +wordToBigNat :: Word# -> BigNat +wordToBigNat w = BN# (B.bigNatFromWord# w) + +wordToBigNat2 :: Word# -> Word# -> BigNat +wordToBigNat2 h l = BN# (B.bigNatFromWord2# h l) + +bigNatToInt :: BigNat -> Int# +bigNatToInt (BN# b) = B.bigNatToInt# b + +bigNatToWord :: BigNat -> Word# +bigNatToWord (BN# b) = B.bigNatToWord# b + +{-# DEPRECATED indexBigNat# "Use bigNatIndex# instead" #-} +indexBigNat# :: BigNat -> GmpSize# -> GmpLimb# +indexBigNat# (BN# b) i = B.bigNatIndex# b i + +{-# DEPRECATED importBigNatFromByteArray "Use bigNatFromByteArray# instead" #-} +importBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> BigNat +importBigNatFromByteArray ba off sz endian = case runRW# (B.bigNatFromByteArray# sz ba off endian) of + (# _, r #) -> BN# r + +{-# DEPRECATED exportBigNatToMutableByteArray "Use bigNatToMutableByteArray# instead" #-} +exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word +exportBigNatToMutableByteArray (BN# ba) mba off endian = IO (\s -> case B.bigNatToMutableByteArray# ba mba off endian s of + (# s', r #) -> (# s', W# r #)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8a2568b7b64e5b9fca5b12df7da759de4db39ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a8a2568b7b64e5b9fca5b12df7da759de4db39ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 07:09:30 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 01 Sep 2020 03:09:30 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] [macOS] improved runpath handling Message-ID: <5f4df3aacf675_80bdb9d70c1008678@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: c4ee4e7d by Moritz Angermann at 2020-09-01T15:08:47+08:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - 15 changed files: - aclocal.m4 - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - docs/users_guide/phases.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - mk/config.mk.in Changes: ===================================== aclocal.m4 ===================================== @@ -579,6 +579,18 @@ AC_DEFUN([FP_SETTINGS], else SettingsOptCommand="$OptCmd" fi + if test -z "$OtoolCmd" + then + SettingsOtoolCommand="otool" + else + SettingsOtoolCommand="$OtoolCmd" + fi + if test -z "$InstallNameToolCmd" + then + SettingsInstallNameToolCommand="install_name_tool" + else + SettingsInstallNameToolCommand="$InstallNameToolCmd" + fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -596,6 +608,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -394,7 +394,56 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commans. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1787,9 +1836,12 @@ linkBinary' staticLink dflags o_files dep_units = do rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then GHC.SysTools.runLibtool - else GHC.SysTools.runLink + let link dflags args | staticLink = GHC.SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = GHC.SysTools.runLink dflags args >> GHC.SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = GHC.SysTools.runLink dflags args + link dflags ( map GHC.SysTools.Option verbFlags ++ [ GHC.SysTools.Option "-o" @@ -1856,7 +1908,13 @@ linkBinary' staticLink dflags o_files dep_units = do ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -145,8 +145,8 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, + pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool, + pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -885,6 +885,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags +pgm_otool :: DynFlags -> String +pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) @@ -2267,6 +2271,10 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } + , make_ord_flag defFlag "pgmotool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f} + , make_ord_flag defFlag "pgminstall_name_tool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f} , make_ord_flag defFlag "pgmranlib" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } @@ -3780,7 +3788,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -3791,6 +3798,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -3831,6 +3840,29 @@ default_PIC platform = -- information. _ -> [] + +-- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS +-- version the number of load commands we can embed in a dynamic library are +-- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only +-- link the needed dylibs instead of linking the full dependency closure. +-- +-- If we split the library linking into injecting -rpath and -l @rpath/... +-- components, we will reduce the number of libraries we link, however we will +-- still inject one -rpath entry for each library, independent of their use. +-- That is, we even inject -rpath values for libraries that we dead_strip in +-- the end. As such we can run afoul of the load command size limit simply +-- by polluting the load commands with RPATH entries. +-- +-- Thus, we disable Opt_RPath by default on OSDarwin. The savvy user can always +-- enable it with -use-rpath if they so wish. +-- +-- See Note [Dynamic linking on macOS] + +default_RPath :: Platform -> [GeneralFlag] +default_RPath platform | platformOS platform == OSDarwin = [] +default_RPath _ = [Opt_RPath] + + -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -929,20 +929,22 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,6 +34,8 @@ module GHC.Settings , sPgm_windres , sPgm_libtool , sPgm_ar + , sPgm_otool + , sPgm_install_name_tool , sPgm_ranlib , sPgm_lo , sPgm_lc @@ -107,6 +109,8 @@ data ToolSettings = ToolSettings , toolSettings_pgm_windres :: String , toolSettings_pgm_libtool :: String , toolSettings_pgm_ar :: String + , toolSettings_pgm_otool :: String + , toolSettings_pgm_install_name_tool :: String , toolSettings_pgm_ranlib :: String , -- | LLVM: opt llvm optimiser toolSettings_pgm_lo :: (String, [Option]) @@ -216,6 +220,10 @@ sPgm_libtool :: Settings -> String sPgm_libtool = toolSettings_pgm_libtool . sToolSettings sPgm_ar :: Settings -> String sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_otool :: Settings -> String +sPgm_otool = toolSettings_pgm_otool . sToolSettings +sPgm_install_name_tool :: Settings -> String +sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings sPgm_ranlib :: Settings -> String sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings sPgm_lo :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -115,6 +115,8 @@ initSettings top_dir = do windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -191,6 +193,8 @@ initSettings top_dir = do , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) ===================================== compiler/GHC/SysTools.hs ===================================== @@ -259,7 +259,10 @@ linkDynLib dflags0 o_files dep_packages | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `Set.member` ways dflags + -- Only if we want dynamic libraries + WayDyn `Set.member` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -384,8 +387,15 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -28,6 +28,10 @@ import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pa import GHC.SysTools.Process import GHC.SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,34 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included int he load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of liraries end up being turely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath at . +-- +-- See Note: [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths) + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -329,6 +361,17 @@ runAr dflags cwd args = traceToolCommand dflags "ar" $ do let ar = pgm_ar dflags runSomethingFiltered dflags id "Ar" ar args cwd Nothing +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing + runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do let ranlib = pgm_ranlib dflags ===================================== configure.ac ===================================== @@ -697,6 +697,18 @@ else fi AC_SUBST([LibtoolCmd]) +dnl ** Which otool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([OTOOL], [otool]) +OtoolCmd="$OTOOL" +AC_SUBST(OtoolCmd) + +dnl ** Which install_name_tool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool]) +InstallNameToolCmd="$INSTALL_NAME_TOOL" +AC_SUBST(InstallNameToolCmd) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -1520,6 +1532,8 @@ echo "\ libtool : $LibtoolCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd + otool : $OtoolCmd + install_name_tool : $InstallNameToolCmd windres : $WindresCmd dllwrap : $DllWrapCmd genlib : $GenlibCmd ===================================== docs/users_guide/phases.rst ===================================== @@ -95,6 +95,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only). +.. ghc-flag:: -pgmotool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inspect mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and + executables to read the dynamic library dependencies. We will compute + the necessary ``runpath``s to bembed for the dependencies based on the + result of the ``otool`` call. + +.. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inject ``runpath`` into mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inject ``runpath``s into mach-o dynamic + libraries and executables. As detected by the ``otool`` call. + .. ghc-flag:: -pgmwindres ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the program for embedding manifests on Windows. :type: dynamic ===================================== hadrian/cfg/system.config.in ===================================== @@ -151,6 +151,8 @@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ +settings-otool-command = @SettingsOtoolCommand@ +settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-libtool-command = @SettingsLibtoolCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -114,6 +114,8 @@ data SettingsFileSetting | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_OtoolCommand + | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_LibtoolCommand @@ -200,6 +202,8 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_OtoolCommand -> "settings-otool-command" + SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -308,6 +308,8 @@ generateSettings = do , ("ar flags", expr $ lookupValueOrError configFile "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) ===================================== includes/ghc.mk ===================================== @@ -233,6 +233,8 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ + @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -504,6 +504,8 @@ SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4ee4e7d6ec1dcba74752d31238867953a9cdc79 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4ee4e7d6ec1dcba74752d31238867953a9cdc79 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 07:38:18 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Sep 2020 03:38:18 -0400 Subject: [Git][ghc/ghc][wip/T18565] 22 commits: Consolidate imports in getMinimalImports (#18264) Message-ID: <5f4dfa6a551a0_80b5c07a4c10087360@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18565 at Glasgow Haskell Compiler / GHC Commits: 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - ce810558 by Sebastian Graf at 2020-09-01T09:38:08+02:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 453092e3 by Sebastian Graf at 2020-09-01T09:38:08+02:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 22 changed files: - .gitignore - aclocal.m4 - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/SysTools/BaseDir.hs - compiler/GHC/Tc/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc8ab7c96439da7fb595239a83793c80346967e8...453092e32fea5057eae9354b2444a49fa28a783f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fc8ab7c96439da7fb595239a83793c80346967e8...453092e32fea5057eae9354b2444a49fa28a783f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 07:52:33 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Sep 2020 03:52:33 -0400 Subject: [Git][ghc/ghc][wip/T18341] 24 commits: Consolidate imports in getMinimalImports (#18264) Message-ID: <5f4dfdc1a2e1d_80b3f84876b14441009660@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18341 at Glasgow Haskell Compiler / GHC Commits: 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - ce810558 by Sebastian Graf at 2020-09-01T09:38:08+02:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 453092e3 by Sebastian Graf at 2020-09-01T09:38:08+02:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 766aa777 by Sebastian Graf at 2020-09-01T09:40:19+02:00 .gitignore *.hiedb files - - - - - efa619f8 by Sebastian Graf at 2020-09-01T09:52:20+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273. - - - - - 18 changed files: - .gitignore - aclocal.m4 - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42f9bf20d2d7c9d190023ad053eec82b9d1aad27...efa619f8b135dc4af00646fecfa2787deea1058d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/42f9bf20d2d7c9d190023ad053eec82b9d1aad27...efa619f8b135dc4af00646fecfa2787deea1058d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 07:55:38 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Sep 2020 03:55:38 -0400 Subject: =?UTF-8?Q?[Git][ghc/ghc][wip/T18341]_PmCheck:_Handle_=E2=8A=A5_and?= =?UTF-8?Q?_strict_fields_correctly_=28#18341=29?= Message-ID: <5f4dfe7a216c4_80b3f8453ed0d3410097085@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18341 at Glasgow Haskell Compiler / GHC Commits: beffbc38 by Sebastian Graf at 2020-09-01T09:54:48+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273. Metric Decrease: T12227 - - - - - 24 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/HsToCore/PmCheck/Types.hs-boot - compiler/GHC/Tc/Types.hs - + testsuite/tests/pmcheck/should_compile/T10183.hs - testsuite/tests/pmcheck/should_compile/T17340.stderr - + testsuite/tests/pmcheck/should_compile/T17378.hs - + testsuite/tests/pmcheck/should_compile/T17725.hs - + testsuite/tests/pmcheck/should_compile/T17725.stderr - + testsuite/tests/pmcheck/should_compile/T17729.hs - + testsuite/tests/pmcheck/should_compile/T17729.stderr - + testsuite/tests/pmcheck/should_compile/T18273.hs - + testsuite/tests/pmcheck/should_compile/T18341.hs - + testsuite/tests/pmcheck/should_compile/T18341.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -53,7 +53,7 @@ module GHC.Core.DataCon ( -- ** Predicates on DataCons isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon, isUnboxedSumCon, - isVanillaDataCon, classDataCon, dataConCannotMatch, + isVanillaDataCon, isNewDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsArePermuted, isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked, specialPromotedDc, @@ -1477,6 +1477,10 @@ isUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc isVanillaDataCon :: DataCon -> Bool isVanillaDataCon dc = dcVanilla dc +-- | Is this the 'DataCon' of a newtype? +isNewDataCon :: DataCon -> Bool +isNewDataCon dc = isNewTyCon (dataConTyCon dc) + -- | Should this DataCon be allowed in a type even without -XDataKinds? -- Currently, only Lifted & Unlifted specialPromotedDc :: DataCon -> Bool ===================================== compiler/GHC/Data/Bag.hs ===================================== @@ -6,7 +6,7 @@ Bag: an unordered collection with duplicates -} -{-# LANGUAGE ScopedTypeVariables, CPP, DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, CPP, DeriveFunctor, TypeFamilies #-} module GHC.Data.Bag ( Bag, -- abstract type @@ -27,9 +27,9 @@ module GHC.Data.Bag ( import GHC.Prelude +import GHC.Exts ( IsList(..) ) import GHC.Utils.Outputable import GHC.Utils.Misc - import GHC.Utils.Monad import Control.Monad import Data.Data @@ -333,3 +333,8 @@ instance Traversable Bag where traverse f (UnitBag x) = UnitBag <$> f x traverse f (TwoBags b1 b2) = TwoBags <$> traverse f b1 <*> traverse f b2 traverse f (ListBag xs) = ListBag <$> traverse f xs + +instance IsList (Bag a) where + type Item (Bag a) = a + fromList = listToBag + toList = bagToList ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -184,8 +184,8 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = ty , pat_ticks = (rhs_tick, var_ticks) }) - = do { rhss_deltas <- covCheckGRHSs PatBindGuards grhss - ; body_expr <- dsGuarded grhss ty rhss_deltas + = do { rhss_nablas <- covCheckGRHSs PatBindGuards grhss + ; body_expr <- dsGuarded grhss ty rhss_nablas ; let body' = mkOptTickBox rhs_tick body_expr pat' = decideBangHood dflags pat ; (force_var,sel_binds) <- mkSelectorBinds var_ticks pat body' ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -215,8 +215,8 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss , pat_ext = ty }) body = -- let C x# y# = rhs in body -- ==> case rhs of C x# y# -> body - do { match_deltas <- covCheckGRHSs PatBindGuards grhss - ; rhs <- dsGuarded grhss ty match_deltas + do { match_nablas <- covCheckGRHSs PatBindGuards grhss + ; rhs <- dsGuarded grhss ty match_nablas ; let upat = unLoc pat eqn = EqnInfo { eqn_pats = [upat], eqn_orig = FromSource, @@ -486,8 +486,8 @@ dsExpr (HsMultiIf res_ty alts) | otherwise = do { let grhss = GRHSs noExtField alts (noLoc emptyLocalBinds) - ; rhss_deltas <- covCheckGRHSs IfAlt grhss - ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_deltas + ; rhss_nablas <- covCheckGRHSs IfAlt grhss + ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_nablas ; error_expr <- mkErrorExpr ; extractMatchResult match_result error_expr } where ===================================== compiler/GHC/HsToCore/GuardedRHSs.hs ===================================== @@ -25,7 +25,7 @@ import GHC.Core.Utils (bindNonRec) import GHC.HsToCore.Monad import GHC.HsToCore.Utils -import GHC.HsToCore.PmCheck.Types ( Deltas ) +import GHC.HsToCore.PmCheck.Types ( Nablas ) import GHC.Core.Type ( Type ) import GHC.Utils.Misc import GHC.Types.SrcLoc @@ -48,9 +48,9 @@ producing an expression with a runtime error in the corner case if necessary. The type argument gives the type of the @ei at . -} -dsGuarded :: GRHSs GhcTc (LHsExpr GhcTc) -> Type -> NonEmpty Deltas -> DsM CoreExpr -dsGuarded grhss rhs_ty rhss_deltas = do - match_result <- dsGRHSs PatBindRhs grhss rhs_ty rhss_deltas +dsGuarded :: GRHSs GhcTc (LHsExpr GhcTc) -> Type -> NonEmpty Nablas -> DsM CoreExpr +dsGuarded grhss rhs_ty rhss_nablas = do + match_result <- dsGRHSs PatBindRhs grhss rhs_ty rhss_nablas error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty empty extractMatchResult match_result error_expr @@ -59,28 +59,28 @@ dsGuarded grhss rhs_ty rhss_deltas = do dsGRHSs :: HsMatchContext GhcRn -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ Guarded RHSs -> Type -- ^ Type of RHS - -> NonEmpty Deltas -- ^ Refined pattern match checking + -> NonEmpty Nablas -- ^ Refined pattern match checking -- models, one for the pattern part and -- one for each GRHS. -> DsM (MatchResult CoreExpr) -dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty rhss_deltas +dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty rhss_nablas = ASSERT( notNull grhss ) - do { match_results <- ASSERT( length grhss == length rhss_deltas ) - zipWithM (dsGRHS hs_ctx rhs_ty) (toList rhss_deltas) grhss - ; deltas <- getPmDeltas - -- We need to remember the Deltas from the particular match context we + do { match_results <- ASSERT( length grhss == length rhss_nablas ) + zipWithM (dsGRHS hs_ctx rhs_ty) (toList rhss_nablas) grhss + ; nablas <- getPmNablas + -- We need to remember the Nablas from the particular match context we -- are in, which might be different to when dsLocalBinds is actually -- called. - ; let ds_binds = updPmDeltas deltas . dsLocalBinds binds + ; let ds_binds = updPmNablas nablas . dsLocalBinds binds match_result1 = foldr1 combineMatchResults match_results match_result2 = adjustMatchResultDs ds_binds match_result1 -- NB: nested dsLet inside matchResult ; return match_result2 } -dsGRHS :: HsMatchContext GhcRn -> Type -> Deltas -> LGRHS GhcTc (LHsExpr GhcTc) +dsGRHS :: HsMatchContext GhcRn -> Type -> Nablas -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (MatchResult CoreExpr) -dsGRHS hs_ctx rhs_ty rhs_deltas (L _ (GRHS _ guards rhs)) - = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs_deltas rhs rhs_ty +dsGRHS hs_ctx rhs_ty rhs_nablas (L _ (GRHS _ guards rhs)) + = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs_nablas rhs rhs_ty {- ************************************************************************ @@ -92,7 +92,7 @@ dsGRHS hs_ctx rhs_ty rhs_deltas (L _ (GRHS _ guards rhs)) matchGuards :: [GuardStmt GhcTc] -- Guard -> HsStmtContext GhcRn -- Context - -> Deltas -- The RHS's covered set for PmCheck + -> Nablas -- The RHS's covered set for PmCheck -> LHsExpr GhcTc -- RHS -> Type -- Type of RHS of guard -> DsM (MatchResult CoreExpr) @@ -100,8 +100,8 @@ matchGuards :: [GuardStmt GhcTc] -- Guard -- See comments with HsExpr.Stmt re what a BodyStmt means -- Here we must be in a guard context (not do-expression, nor list-comp) -matchGuards [] _ deltas rhs _ - = do { core_rhs <- updPmDeltas deltas (dsLExpr rhs) +matchGuards [] _ nablas rhs _ + = do { core_rhs <- updPmNablas nablas (dsLExpr rhs) ; return (cantFailMatchResult core_rhs) } -- BodyStmts must be guards @@ -111,31 +111,31 @@ matchGuards [] _ deltas rhs _ -- NB: The success of this clause depends on the typechecker not -- wrapping the 'otherwise' in empty HsTyApp or HsWrap constructors -- If it does, you'll get bogus overlap warnings -matchGuards (BodyStmt _ e _ _ : stmts) ctx deltas rhs rhs_ty +matchGuards (BodyStmt _ e _ _ : stmts) ctx nablas rhs rhs_ty | Just addTicks <- isTrueLHsExpr e = do - match_result <- matchGuards stmts ctx deltas rhs rhs_ty + match_result <- matchGuards stmts ctx nablas rhs rhs_ty return (adjustMatchResultDs addTicks match_result) -matchGuards (BodyStmt _ expr _ _ : stmts) ctx deltas rhs rhs_ty = do - match_result <- matchGuards stmts ctx deltas rhs rhs_ty +matchGuards (BodyStmt _ expr _ _ : stmts) ctx nablas rhs rhs_ty = do + match_result <- matchGuards stmts ctx nablas rhs rhs_ty pred_expr <- dsLExpr expr return (mkGuardedMatchResult pred_expr match_result) -matchGuards (LetStmt _ binds : stmts) ctx deltas rhs rhs_ty = do - match_result <- matchGuards stmts ctx deltas rhs rhs_ty +matchGuards (LetStmt _ binds : stmts) ctx nablas rhs rhs_ty = do + match_result <- matchGuards stmts ctx nablas rhs rhs_ty return (adjustMatchResultDs (dsLocalBinds binds) match_result) -- NB the dsLet occurs inside the match_result -- Reason: dsLet takes the body expression as its argument -- so we can't desugar the bindings without the -- body expression in hand -matchGuards (BindStmt _ pat bind_rhs : stmts) ctx deltas rhs rhs_ty = do +matchGuards (BindStmt _ pat bind_rhs : stmts) ctx nablas rhs rhs_ty = do let upat = unLoc pat match_var <- selectMatchVar Many upat -- We only allow unrestricted patterns in guard, hence the `Many` -- above. It isn't clear what linear patterns would mean, maybe we will -- figure it out in the future. - match_result <- matchGuards stmts ctx deltas rhs rhs_ty + match_result <- matchGuards stmts ctx nablas rhs rhs_ty core_rhs <- dsLExpr bind_rhs match_result' <- matchSinglePatVar match_var (Just core_rhs) (StmtCtxt ctx) pat rhs_ty match_result ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -35,7 +35,7 @@ import GHC.Tc.Utils.Zonk import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad import GHC.HsToCore.PmCheck -import GHC.HsToCore.PmCheck.Types ( Deltas, initDeltas ) +import GHC.HsToCore.PmCheck.Types ( Nablas, initNablas ) import GHC.Core import GHC.Types.Literal import GHC.Core.Utils @@ -766,31 +766,31 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches (hsLMatchPats m)) -- Pattern match check warnings for /this match-group/. - -- @rhss_deltas@ is a flat list of covered Deltas for each RHS. - -- Each Match will split off one Deltas for its RHSs from this. - ; matches_deltas <- if isMatchContextPmChecked dflags origin ctxt + -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. + -- Each Match will split off one Nablas for its RHSs from this. + ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt then addHsScrutTmCs mb_scr new_vars $ -- See Note [Long-distance information] covCheckMatches (DsMatchContext ctxt locn) new_vars matches - else pure (initDeltasMatches matches) + else pure (initNablasMatches matches) - ; eqns_info <- zipWithM mk_eqn_info matches matches_deltas + ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas ; result_expr <- handleWarnings $ matchEquations ctxt new_vars eqns_info rhs_ty ; return (new_vars, result_expr) } where -- Called once per equation in the match, or alternative in the case - mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Deltas, NonEmpty Deltas) -> DsM EquationInfo - mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_deltas, rhss_deltas) + mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo + mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas) = do { dflags <- getDynFlags ; let upats = map (unLoc . decideBangHood dflags) pats - -- pat_deltas is the covered set *after* matching the pattern, but - -- before any of the GRHSs. We extend the environment with pat_deltas - -- (via updPmDeltas) so that the where-clause of 'grhss' can profit + -- pat_nablas is the covered set *after* matching the pattern, but + -- before any of the GRHSs. We extend the environment with pat_nablas + -- (via updPmNablas) so that the where-clause of 'grhss' can profit -- from that knowledge (#18533) - ; match_result <- updPmDeltas pat_deltas $ - dsGRHSs ctxt grhss rhs_ty rhss_deltas + ; match_result <- updPmNablas pat_nablas $ + dsGRHSs ctxt grhss rhs_ty rhss_nablas ; return EqnInfo { eqn_pats = upats , eqn_orig = FromSource , eqn_rhs = match_result } } @@ -799,14 +799,14 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches then discardWarningsDs else id - initDeltasMatches :: [LMatch GhcTc b] -> [(Deltas, NonEmpty Deltas)] - initDeltasMatches ms - = map (\(L _ m) -> (initDeltas, initDeltasGRHSs (m_grhss m))) ms + initNablasMatches :: [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] + initNablasMatches ms + = map (\(L _ m) -> (initNablas, initNablasGRHSs (m_grhss m))) ms - initDeltasGRHSs :: GRHSs GhcTc b -> NonEmpty Deltas - initDeltasGRHSs m = expectJust "GRHSs non-empty" + initNablasGRHSs :: GRHSs GhcTc b -> NonEmpty Nablas + initNablasGRHSs m = expectJust "GRHSs non-empty" $ NEL.nonEmpty - $ replicate (length (grhssGRHSs m)) initDeltas + $ replicate (length (grhssGRHSs m)) initNablas matchEquations :: HsMatchContext GhcRn ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -34,7 +34,7 @@ module GHC.HsToCore.Monad ( DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv, -- Getting and setting pattern match oracle states - getPmDeltas, updPmDeltas, + getPmNablas, updPmNablas, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -304,7 +304,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span - , dsl_deltas = initDeltas + , dsl_nablas = initNablas } in (gbl_env, lcl_env) @@ -403,14 +403,14 @@ the @SrcSpan@ being carried around. getGhcModeDs :: DsM GhcMode getGhcModeDs = getDynFlags >>= return . ghcMode --- | Get the current pattern match oracle state. See 'dsl_deltas'. -getPmDeltas :: DsM Deltas -getPmDeltas = do { env <- getLclEnv; return (dsl_deltas env) } +-- | Get the current pattern match oracle state. See 'dsl_nablas'. +getPmNablas :: DsM Nablas +getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } -- | Set the pattern match oracle state within the scope of the given action. --- See 'dsl_deltas'. -updPmDeltas :: Deltas -> DsM a -> DsM a -updPmDeltas deltas = updLclEnv (\env -> env { dsl_deltas = deltas }) +-- See 'dsl_nablas'. +updPmNablas :: Nablas -> DsM a -> DsM a +updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -28,14 +28,14 @@ -- a. The set of uncovered values, 'cr_uncov' -- b. And an annotated tree variant (like 'AnnMatch') that captures -- redundancy and inaccessibility information as 'RedSets' annotations --- Basically the UA function from Section 5.1. The Normalised Refinement Types --- Nabla are modeled as 'Deltas' and checked in "GHC.HsToCore.PmCheck.Oracle". +-- Basically the UA function from Section 5.1. The Normalised Refinement +-- Types 'Nablas' are maintained in "GHC.HsToCore.PmCheck.Oracle". -- 3. Collect redundancy information into a 'CIRB' with a 'CIRBCollector' such -- as 'collectMatch'. Follows the R function from Figure 6 of the paper. -- 4. Format and report uncovered patterns and redundant equations ('CIRB') -- with 'formatReportWarnings'. Basically job of the G function, plus proper -- pretty printing of the warnings (Section 5.4 of the paper). --- 5. Return 'Deltas' reaching syntactic sub-components for +-- 5. Return 'Nablas' reaching syntactic sub-components for -- Note [Long-distance information]. See Section 4.1 of the paper. module GHC.HsToCore.PmCheck ( -- Checking and printing @@ -68,7 +68,6 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Core.DataCon -import GHC.Core.TyCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper) @@ -103,7 +102,7 @@ import Data.Coerce covCheckPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [covCheckPatBind only checks PatBindRhs] covCheckPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do - missing <- getPmDeltas + missing <- getPmNablas pat_bind <- desugarPatBind loc var p tracePm "covCheckPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result <- unCA (checkPatBind pat_bind) missing @@ -112,17 +111,17 @@ covCheckPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do covCheckPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and --- in @MultiIf@ expressions. Returns the 'Deltas' covered by the RHSs. +-- in @MultiIf@ expressions. Returns the 'Nablas' covered by the RHSs. covCheckGRHSs :: HsMatchContext GhcRn -- ^ Match context, for warning messages -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check - -> DsM (NonEmpty Deltas) -- ^ Covered 'Deltas' for each RHS, for long + -> DsM (NonEmpty Nablas) -- ^ Covered 'Nablas' for each RHS, for long -- distance info covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do let combined_loc = foldl1 combineSrcSpans (map getLoc grhss) ctxt = DsMatchContext hs_ctxt combined_loc matches <- desugarGRHSs combined_loc empty guards - missing <- getPmDeltas + missing <- getPmNablas tracePm "covCheckGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -140,7 +139,7 @@ covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- f _ _ = 3 -- clause with a single, un-guarded RHS -- @ -- --- Returns one non-empty 'Deltas' for 1.) each pattern of a 'Match' and 2.) +-- Returns one non-empty 'Nablas' for 1.) each pattern of a 'Match' and 2.) -- each of a 'Match'es 'GRHS' for Note [Long-distance information]. -- -- Special case: When there are /no matches/, then the functionassumes it @@ -150,13 +149,13 @@ covCheckMatches :: DsMatchContext -- ^ Match context, for warnings messages -> [Id] -- ^ Match variables, i.e. x and y above -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches - -> DsM [(Deltas, NonEmpty Deltas)] -- ^ One covered 'Deltas' per Match and + -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and -- GRHS, for long distance info. covCheckMatches ctxt vars matches = do -- We have to force @missing@ before printing out the trace message, -- otherwise we get interleaved output from the solver. This function -- should be strict in @missing@ anyway! - !missing <- getPmDeltas + !missing <- getPmNablas tracePm "covCheckMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 @@ -207,7 +206,7 @@ exception into divergence (@f x = f x@). Semantically, unlike every other case expression, -XEmptyCase is strict in its match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the -initial Delta and check if there are any values left to match on. +initial Nabla and check if there are any values left to match on. -} -- @@ -233,8 +232,8 @@ data PmGrd -- bang pattern, in which case we might want to report it as redundant. -- See Note [Dead bang patterns]. | PmBang { - pm_id :: !Id, - pm_loc :: !(Maybe SrcInfo) + pm_id :: !Id, + _pm_loc :: !(Maybe SrcInfo) } -- | @PmLet x expr@ corresponds to a @let x = expr@ guard. This actually @@ -298,15 +297,15 @@ newtype GrdPatBind = -- (later digested into a 'CIRB'). data RedSets = RedSets - { rs_cov :: !Deltas + { rs_cov :: !Nablas -- ^ The /Covered/ set; the set of values reaching a particular program -- point. - , rs_div :: !Deltas + , rs_div :: !Nablas -- ^ The /Diverging/ set; empty if no match can lead to divergence. -- If it wasn't empty, we have to turn redundancy warnings into -- inaccessibility warnings for any subclauses. - , rs_bangs :: !(OrdList (Deltas, SrcInfo)) - -- ^ If any of the 'Deltas' is empty, the corresponding 'SrcInfo' pin-points + , rs_bangs :: !(OrdList (Nablas, SrcInfo)) + -- ^ If any of the 'Nablas' is empty, the corresponding 'SrcInfo' pin-points -- a bang pattern in source that is redundant. See Note [Dead bang patterns]. } @@ -434,7 +433,7 @@ vanillaConGrd scrut con arg_ids = -- For example: -- @mkListGrds "a" "[(x, True <- x),(y, !y)]"@ -- to --- @"[(x:b) <- a, True <- x, (y:c) <- b, seq y True, [] <- c]"@ +-- @"[(x:b) <- a, True <- x, (y:c) <- b, !y, [] <- c]"@ -- where @b@ and @c@ are freshly allocated in @mkListGrds@ and @a@ is the match -- variable. mkListGrds :: Id -> [(Id, GrdVec)] -> DsM GrdVec @@ -618,7 +617,7 @@ desugarListPat x pats = do -- | Desugar a constructor pattern desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar] - -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdVec + -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdVec desugarConPatOut x con univ_tys ex_tvs dicts = \case PrefixCon ps -> go_field_pats (zip [0..] ps) InfixCon p1 p2 -> go_field_pats (zip [0..] [p1,p2]) @@ -638,14 +637,14 @@ desugarConPatOut x con univ_tys ex_tvs dicts = \case lbl_to_index lbl = expectJust "lbl_to_index" $ elemIndex lbl orig_lbls go_field_pats tagged_pats = do - -- The fields that appear might not be in the correct order. So first - -- do a PmCon match, then force according to field strictness and then - -- force evaluation of the field patterns in the order given by - -- the first field of @tagged_pats at . + -- The fields that appear might not be in the correct order. So + -- 1. Do the PmCon match + -- 2. Then pattern match on the fields in the order given by the first + -- field of @tagged_pats at . -- See Note [Field match order for RecCon] -- Desugar the mentioned field patterns. We're doing this first to get - -- the Ids for pm_con_args. + -- the Ids for pm_con_args and bring them in order afterwards. let trans_pat (n, pat) = do (var, pvec) <- desugarLPatV pat pure ((n, var), pvec) @@ -659,19 +658,11 @@ desugarConPatOut x con univ_tys ex_tvs dicts = \case arg_ids <- zipWithM get_pat_id [0..] arg_tys let con_grd = PmCon x (PmAltConLike con) ex_tvs dicts arg_ids - -- 2. bang strict fields - let arg_is_banged = map isBanged $ conLikeImplBangs con - noSrcPmBang i = PmBang {pm_id = i, pm_loc = Nothing} - bang_grds = map noSrcPmBang (filterByList arg_is_banged arg_ids) - - -- 3. guards from field selector patterns + -- 2. guards from field selector patterns let arg_grds = concat arg_grdss -- tracePm "ConPatOut" (ppr x $$ ppr con $$ ppr arg_ids) - -- - -- Store the guards in exactly that order - -- 1. 2. 3. - pure (con_grd : bang_grds ++ arg_grds) + pure (con_grd : arg_grds) desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM GrdPatBind -- See 'GrdPatBind' for how this simply repurposes GrdGRHS. @@ -759,30 +750,45 @@ desugarBoolGuard e -> pure [vanillaConGrd y trueDataCon []] rhs -> do x <- mkPmId boolTy - pure $ [PmLet x rhs, vanillaConGrd x trueDataCon []] + pure [PmLet x rhs, vanillaConGrd x trueDataCon []] {- Note [Field match order for RecCon] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The order for RecCon field patterns actually determines evaluation order of the pattern match. For example: - data T = T { a :: !Bool, b :: Char, c :: Int } + data T = T { a :: Char, b :: Int } f :: T -> () - f T{ c = 42, b = 'b' } = () + f T{ b = 42, a = 'a' } = () + +Then @f (T (error "a") (error "b"))@ errors out with "b" because it is mentioned +first in the pattern match. -Then - * @f (T (error "a") (error "b") (error "c"))@ errors out with "a" because of - the strict field. - * @f (T True (error "b") (error "c"))@ errors out with "c" because it - is mentioned frist in the pattern match. +This means we can't just desugar the pattern match to +@[T a b <- x, 'a' <- a, 42 <- b]@. Instead we have to force them in the +right order: @[T a b <- x, 42 <- b, 'a' <- a]@. -This means we can't just desugar the pattern match to the PatVec -@[T !_ 'b' 42]@. Instead we have to generate variable matches that have -strictness according to the field declarations and afterwards force them in the -right order. As a result, we get the PatVec @[T !_ b c, 42 <- c, 'b' <- b]@. +Note [Strict fields and fields of unlifted type] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +How do strict fields play into Note [Field match order for RecCon]? Answer: +They don't. Desugaring is entirely unconcerned by strict fields; the forcing +happens *before* pattern matching. But for each strict (or more generally, +unlifted) field @s@ we have to add @s /~ ⊥@ constraints when we check the PmCon +guard in 'checkGrd'. Strict fields are devoid of ⊥ by construction, there's +nothing that a bang pattern would act on. Example from #18341: + + data T = MkT !Int + f :: T -> () + f (MkT _) | False = () -- inaccessible + f (MkT !_) | False = () -- redundant, not only inaccessible! + f _ = () -Of course, when the labels occur in the order they are defined, we can just use -the simpler desugaring. +The second clause desugars to @MkT n <- x, !n at . When coverage checked, the +'PmCon' @MkT n <- x@ refines the set of values that reach the bang pattern with +the constraints @x ~ MkT n, n /~ ⊥@ (this list is computed by 'pmConCts'). +Checking the 'PmBang' @!n@ will then try to add the constraint @n ~ ⊥@ to this +set to get the diverging set, which is found to be empty. Hence the whole +clause is detected as redundant, as expected. Note [Order of guards matters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -834,7 +840,7 @@ data CheckResult a = CheckResult { cr_ret :: !a -- ^ A hole for redundancy info and covered sets. - , cr_uncov :: !Deltas + , cr_uncov :: !Nablas -- ^ The set of uncovered values falling out at the bottom. -- (for -Wincomplete-patterns, but also important state for the algorithm) , cr_approx :: !Precision @@ -852,23 +858,23 @@ instance Outputable a => Outputable (CheckResult a) where ppr_precision Approximate = text "(Approximate)" field name value = text name <+> equals <+> ppr value --- | Lift 'addPmCts' over 'Deltas'. -addPmCtsDeltas :: Deltas -> PmCts -> DsM Deltas -addPmCtsDeltas deltas cts = liftDeltasM (\d -> addPmCts d cts) deltas +-- | Lift 'addPmCts' over 'Nablas'. +addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas +addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas --- | 'addPmCtsDeltas' for a single 'PmCt'. -addPmCtDeltas :: Deltas -> PmCt -> DsM Deltas -addPmCtDeltas deltas ct = addPmCtsDeltas deltas (unitBag ct) +-- | 'addPmCtsNablas' for a single 'PmCt'. +addPmCtNablas :: Nablas -> PmCt -> DsM Nablas +addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) --- | Test if any of the 'Delta's is inhabited. Currently this is pure, because --- we preserve the invariant that there are no uninhabited 'Delta's. But that +-- | Test if any of the 'Nabla's is inhabited. Currently this is pure, because +-- we preserve the invariant that there are no uninhabited 'Nabla's. But that -- could change in the future, for example by implementing this function in -- terms of @notNull <$> provideEvidence 1 ds at . -isInhabited :: Deltas -> DsM Bool -isInhabited (MkDeltas ds) = pure (not (null ds)) +isInhabited :: Nablas -> DsM Bool +isInhabited (MkNablas ds) = pure (not (null ds)) -- | Coverage checking action. Can be composed 'leftToRight' or 'topToBottom'. -newtype CheckAction a = CA { unCA :: Deltas -> DsM (CheckResult a) } +newtype CheckAction a = CA { unCA :: Nablas -> DsM (CheckResult a) } deriving Functor -- | Composes 'CheckAction's top-to-bottom: @@ -910,23 +916,34 @@ leftToRight f (CA left) (CA right) = CA $ \inc -> do , cr_uncov = uncov' , cr_approx = prec' Semi.<> cr_approx l Semi.<> cr_approx r } --- | @throttle limit old new@ returns @old@ if the number of 'Delta's in @new@ --- is exceeding the given @limit@ and the @old@ number of 'Delta's. +-- | @throttle limit old new@ returns @old@ if the number of 'Nabla's in @new@ +-- is exceeding the given @limit@ and the @old@ number of 'Nabla's. -- See Note [Countering exponential blowup]. -throttle :: Int -> Deltas -> Deltas -> (Precision, Deltas) -throttle limit old@(MkDeltas old_ds) new@(MkDeltas new_ds) +throttle :: Int -> Nablas -> Nablas -> (Precision, Nablas) +throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) --- | pprTrace "PmCheck:throttle" (ppr (length old_ds) <+> ppr (length new_ds) <+> ppr limit) False = undefined | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | Matching on a newtype doesn't force anything. --- See Note [Divergence of Newtype matches] in "GHC.HsToCore.PmCheck.Oracle". -conMatchForces :: PmAltCon -> Bool -conMatchForces (PmAltConLike (RealDataCon dc)) - | isNewTyCon (dataConTyCon dc) = False -conMatchForces _ = True - --- First the functions that correspond to checking LYG primitives: +-- | The 'PmCts' arising from a successful 'PmCon' match @T gammas as ys <- x at . +-- These include +-- +-- * @gammas@: Constraints arising from the bound evidence vars +-- * @y /~ ⊥@ constraints for each unlifted field (including strict fields) +-- @y@ in @ys@ +-- * The constructor constraint itself: @x ~ T as ys at . +-- +-- See Note [Strict fields and fields of unlifted type]. +pmConCts :: Id -> PmAltCon -> [TyVar] -> [EvVar] -> [Id] -> PmCts +pmConCts x con tvs dicts args = gammas `unionBags` unlifted `snocBag` con_ct + where + gammas = listToBag $ map (PmTyCt . evVarPred) dicts + con_ct = PmConCt x con tvs args + unlifted = listToBag [ PmNotBotCt arg + | (arg, bang) <- + zipEqual "pmConCts" args (pmAltConImplBangs con) + , isBanged bang || isUnliftedType (idType arg) + ] checkSequence :: (grdtree -> CheckAction anntree) -> NonEmpty grdtree -> CheckAction (NonEmpty anntree) -- The implementation is pretty similar to @@ -939,31 +956,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtDeltas inc (PmCoreCt x e) + matched <- addPmCtNablas inc (PmCoreCt x e) + -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x /~ ⊥ PmBang x mb_info -> do - div <- addPmCtDeltas inc (PmBotCt x) - matched <- addPmCtDeltas inc (PmNotBotCt x) + div <- addPmCtNablas inc (PmBotCt x) + matched <- addPmCtNablas inc (PmNotBotCt x) -- See Note [Dead bang patterns] -- mb_info = Just info <==> PmBang originates from bang pattern in source let bangs | Just info <- mb_info = unitOL (div, info) | otherwise = NilOL + -- tracePm "check:Bang" (ppr x <+> ppr div) pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } , cr_uncov = mempty , cr_approx = Precise } - -- Con: Diverge on x ~ ⊥, fall through on x /~ K and refine with x ~ K ys - -- and type info + -- Con: Fall through on x /~ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do - div <- if conMatchForces con - then addPmCtDeltas inc (PmBotCt x) + !div <- if isPmAltConMatchStrict con + then addPmCtNablas inc (PmBotCt x) else pure mempty - uncov <- addPmCtDeltas inc (PmNotConCt x con) - matched <- addPmCtsDeltas inc $ - listToBag (PmTyCt . evVarPred <$> dicts) `snocBag` PmConCt x con tvs args - -- tracePm "checkGrd:Con" (ppr inc $$ ppr x $$ ppr con $$ ppr dicts $$ ppr matched) + let con_cts = pmConCts x con tvs dicts args + !matched <- addPmCtsNablas inc con_cts + !uncov <- addPmCtNablas inc (PmNotConCt x con) + -- tracePm "checkGrd:Con" (ppr inc $$ ppr grd $$ ppr con_cts $$ ppr matched) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -997,7 +1015,7 @@ checkGRHS (GrdGRHS { gg_grds = grds, gg_rhs = rhs_info }) = checkEmptyCase :: GrdEmptyCase -> CheckAction AnnEmptyCase checkEmptyCase (GrdEmptyCase { ge_var = var }) = CA $ \inc -> do - unc <- addPmCtDeltas inc (PmNotBotCt var) + unc <- addPmCtNablas inc (PmNotBotCt var) pure CheckResult { cr_ret = AnnEmptyCase, cr_uncov = unc, cr_approx = mempty } checkPatBind :: GrdPatBind -> CheckAction AnnPatBind @@ -1007,7 +1025,7 @@ checkPatBind = coerce checkGRHS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Precise pattern match exhaustiveness checking is necessarily exponential in the size of some input programs. We implement a counter-measure in the form of -the -fmax-pmcheck-models flag, limiting the number of Deltas we check against +the -fmax-pmcheck-models flag, limiting the number of Nablas we check against each pattern by a constant. How do we do that? Consider @@ -1016,13 +1034,13 @@ How do we do that? Consider f True True = () And imagine we set our limit to 1 for the sake of the example. The first clause -will be checked against the initial Delta, {}. Doing so will produce an +will be checked against the initial Nabla, {}. Doing so will produce an Uncovered set of size 2, containing the models {x/~True} and {x~True,y/~True}. Also we find the first clause to cover the model {x~True,y~True}. But the Uncovered set we get out of the match is too huge! We somehow have to ensure not to make things worse as they are already, so we continue checking -with a singleton Uncovered set of the initial Delta {}. Why is this +with a singleton Uncovered set of the initial Nabla {}. Why is this sound (wrt. the notion in GADTs Meet Their Match)? Well, it basically amounts to forgetting that we matched against the first clause. The values represented by {} are a superset of those represented by its two refinements {x/~True} and @@ -1093,41 +1111,41 @@ addRedundantBangs red_bangs cirb = -- 1. A 'CIRB', classifying every encountered RHS in the tree as -- redundant, inaccessible or covered. -- 2. A piece of long-distance information @ldi@, consisting of a --- nesting of 'Deltas' mirroring tree structure. +-- nesting of 'Nablas' mirroring tree structure. -- For example, 'collectMatchGroup' operates on a Match Group and thus --- returns a list of 'Deltas' for the pattern part of each Match, as well as --- a further nested list of 'Deltas' for each of the GRHS of the Match. +-- returns a list of 'Nablas' for the pattern part of each Match, as well as +-- a further nested list of 'Nablas' for each of the GRHS of the Match. type CIRBCollector ann ldi = ann -> DsM (CIRB, ldi) --- | Checks the 'Deltas' in a 'RedSets' for inhabitants and returns +-- | Checks the 'Nablas' in a 'RedSets' for inhabitants and returns -- 1. Whether the Covered set was inhabited -- 2. Whether the Diverging set was inhabited -- 3. The new inhabited Covered set for long-distance information. -- See Note [Recovering from unsatisfiable pattern-matching constraints]. --- 4. All source bangs whose 'Deltas' were empty, which means they are +-- 4. All source bangs whose 'Nablas' were empty, which means they are -- redundant. -testRedSets :: Deltas -> RedSets -> DsM (Bool, Bool, Deltas, OrdList SrcInfo) +testRedSets :: Nablas -> RedSets -> DsM (Bool, Bool, Nablas, OrdList SrcInfo) testRedSets ldi RedSets { rs_cov = cov, rs_div = div, rs_bangs = bangs } = do is_covered <- isInhabited cov may_diverge <- isInhabited div - red_bangs <- flip mapMaybeM (fromOL bangs) $ \(deltas, bang) -> do - isInhabited deltas >>= \case + red_bangs <- flip mapMaybeM (fromOL bangs) $ \(nablas, bang) -> do + isInhabited nablas >>= \case True -> pure Nothing False -> pure (Just bang) -- See Note [Recovering from unsatisfiable pattern-matching constraints] - -- Deltas for long-distance info: Use (non-empty!) fallback ldi if Covered + -- Nablas for long-distance info: Use (non-empty!) fallback ldi if Covered -- set was empty let ldi' | is_covered = cov | otherwise = ldi pure (is_covered, may_diverge, ldi', toOL red_bangs) -collectMatchGroup :: Deltas -> CIRBCollector AnnMatchGroup (NonEmpty (Deltas, NonEmpty Deltas)) +collectMatchGroup :: Nablas -> CIRBCollector AnnMatchGroup (NonEmpty (Nablas, NonEmpty Nablas)) collectMatchGroup ldi (AnnMatchGroup matches) = do (cirbs, ldis) <- NE.unzip <$> traverse (collectMatch ldi) matches pure (Semi.sconcat cirbs, ldis) -collectMatch :: Deltas -> CIRBCollector AnnMatch (Deltas, NonEmpty Deltas) +collectMatch :: Nablas -> CIRBCollector AnnMatch (Nablas, NonEmpty Nablas) collectMatch ldi AnnMatch { am_red = red, am_grhss = grhss } = do (is_covered, may_diverge, ldi', red_bangs) <- testRedSets ldi red (cirb, ldis) <- collectGRHSs ldi' grhss @@ -1138,12 +1156,12 @@ collectMatch ldi AnnMatch { am_red = red, am_grhss = grhss } = do $ cirb pure (cirb', (ldi', ldis)) -collectGRHSs :: Deltas -> CIRBCollector (NonEmpty AnnGRHS) (NonEmpty Deltas) +collectGRHSs :: Nablas -> CIRBCollector (NonEmpty AnnGRHS) (NonEmpty Nablas) collectGRHSs ldi grhss = do (cirbs, ldis) <- NE.unzip <$> traverse (collectGRHS ldi) grhss pure (Semi.sconcat cirbs, ldis) -collectGRHS :: Deltas -> CIRBCollector AnnGRHS Deltas +collectGRHS :: Nablas -> CIRBCollector AnnGRHS Nablas collectGRHS ldi AnnGRHS { ag_red = red, ag_rhs = info } = do (is_covered, may_diverge, ldi', red_bangs) <- testRedSets ldi red let cirb | is_covered = mempty { cirb_cov = unitOL info } @@ -1156,9 +1174,9 @@ collectEmptyCase _ = pure (mempty, ()) collectPatBind :: CIRBCollector AnnPatBind () -- We don't make use of long-distance information in pattern bindings, hence --- @()@ instead of some 'Deltas'. +-- @()@ instead of some 'Nablas'. collectPatBind (AnnPatBind grhs) = do - -- use 'mempty' as fallback 'Deltas' because we discard it anyway + -- use 'mempty' as fallback 'Nablas' because we discard it anyway (cirb, _) <- collectGRHS mempty grhs pure (cirb, ()) @@ -1236,10 +1254,10 @@ reportWarnings dflags ctx@(DsMatchContext kind loc) vars f (q <+> matchSeparator kind <+> text "...") -- Print several clauses (for uncovered clauses) - pprEqns vars deltas = pprContext False ctx (text "are non-exhaustive") $ \_ -> + pprEqns vars nablas = pprContext False ctx (text "are non-exhaustive") $ \_ -> case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" - _ -> let us = map (\delta -> pprUncovered delta vars) deltas + _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas in hang (text "Patterns not matched:") 4 (vcat (take maxPatterns us) $$ dots maxPatterns us) @@ -1254,14 +1272,14 @@ reportWarnings dflags ctx@(DsMatchContext kind loc) vars $$ bullet <+> text "Patterns reported as unmatched might actually be matched") , text "Increase the limit or resolve the warnings to suppress this message." ] -getNFirstUncovered :: [Id] -> Int -> Deltas -> DsM [Delta] -getNFirstUncovered vars n (MkDeltas deltas) = go n (bagToList deltas) +getNFirstUncovered :: [Id] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] go _ [] = pure [] - go n (delta:deltas) = do - front <- provideEvidence vars n delta - back <- go (n - length front) deltas + go n (nabla:nablas) = do + front <- provideEvidence vars n nabla + back <- go (n - length front) nablas pure (front ++ back) dots :: Int -> [a] -> SDoc @@ -1386,21 +1404,21 @@ code that we don't want to warn about. -- * Long-distance information -- --- | Locally update 'dsl_deltas' with the given action, but defer evaluation +-- | Locally update 'dsl_nablas' with the given action, but defer evaluation -- with 'unsafeInterleaveM' in order not to do unnecessary work. -locallyExtendPmDeltas :: (Deltas -> DsM Deltas) -> DsM a -> DsM a -locallyExtendPmDeltas ext k = do - deltas <- getPmDeltas - deltas' <- unsafeInterleaveM $ do - deltas' <- ext deltas - inh <- isInhabited deltas' +locallyExtendPmNablas :: (Nablas -> DsM Nablas) -> DsM a -> DsM a +locallyExtendPmNablas ext k = do + nablas <- getPmNablas + nablas' <- unsafeInterleaveM $ do + nablas' <- ext nablas + inh <- isInhabited nablas' -- If adding a constraint would lead to a contradiction, don't add it. -- See Note [Recovering from unsatisfiable pattern-matching constraints] -- for why this is done. if inh - then pure deltas' - else pure deltas - updPmDeltas deltas' k + then pure nablas' + else pure nablas + updPmNablas nablas' k -- | Add in-scope type constraints if the coverage checker might run and then -- run the given action. @@ -1408,7 +1426,7 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmDeltas (\deltas -> addPmCtsDeltas deltas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1419,8 +1437,8 @@ addTyCs origin ev_vars m = do addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = - flip locallyExtendPmDeltas k $ \deltas -> - addPmCtsDeltas deltas (unitBag (PmCoreCt x scr)) + flip locallyExtendPmNablas k $ \nablas -> + addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. @@ -1448,10 +1466,10 @@ of @f at . To achieve similar reasoning in the coverage checker, we keep track of the set of values that can reach a particular program point (often loosely referred to -as "Covered set") in 'GHC.HsToCore.Monad.dsl_deltas'. -We fill that set with Covered Deltas returned by the exported checking +as "Covered set") in 'GHC.HsToCore.Monad.dsl_nablas'. +We fill that set with Covered Nablas returned by the exported checking functions, which the call sites put into place with -'GHC.HsToCore.Monad.updPmDeltas'. +'GHC.HsToCore.Monad.updPmNablas'. Call sites also extend this set with facts from type-constraint dictionaries, case scrutinees, etc. with the exported functions 'addTyCs', 'addCoreScrutTmCs' and 'addHsScrutTmCs'. @@ -1472,9 +1490,9 @@ unreachable. We can do better than this, by making sure that the Covered set used for Note [Long-distance information] is always inhabited. For Covered sets returned by the exported checking functions, that is ensured -in 'testRedSets', which takes and returns a non-empty fallback 'Deltas' in case +in 'testRedSets', which takes and returns a non-empty fallback 'Nablas' in case the refined Covered set became uninhabited. Also, whenever "external" knowledge from a type constraint or case scrutinee is -integrated, we only commit that knowledge to 'GHC.HsToCore.Monad.dsl_deltas' if -the set remains inhabited. That check happens in 'locallyExtendPmDeltas'. +integrated, we only commit that knowledge to 'GHC.HsToCore.Monad.dsl_nablas' if +the set remains inhabited. That check happens in 'locallyExtendPmNablas'. -} ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -4,22 +4,25 @@ Authors: George Karachalias Ryan Scott -} -{-# LANGUAGE CPP, LambdaCase, TupleSections, PatternSynonyms, ViewPatterns, MultiWayIf #-} +{-# LANGUAGE CPP, LambdaCase, TupleSections, PatternSynonyms, ViewPatterns, MultiWayIf, ScopedTypeVariables #-} -- | The pattern match oracle. The main export of the module are the functions -- 'addPmCts' for adding facts to the oracle, and 'provideEvidence' to turn a --- 'Delta' into a concrete evidence for an equation. +-- 'Nabla' into a concrete evidence for an equation. +-- +-- In terms of the [Lower Your Guards paper](https://dl.acm.org/doi/abs/10.1145/3408989) +-- describing the implementation, this module is concerned with Sections 3.4, 3.6 and 3.7. +-- E.g., it represents refinement types diretly as a normalised refinement type 'Nabla'. module GHC.HsToCore.PmCheck.Oracle ( DsM, tracePm, mkPmId, - Delta, initDeltas, lookupRefuts, lookupSolution, + Nabla, initNablas, lookupRefuts, lookupSolution, PmCt(PmTyCt), PmCts, pattern PmVarCt, pattern PmCoreCt, pattern PmConCt, pattern PmNotConCt, pattern PmBotCt, pattern PmNotBotCt, addPmCts, -- Add a constraint to the oracle. - canDiverge, -- Try to add the term equality x ~ ⊥ provideEvidence ) where @@ -153,12 +156,7 @@ mkOneConFull arg_tys con = do -- to the type oracle let ty_cs = substTheta subst (eqSpecPreds eq_spec ++ thetas) -- Figure out the types of strict constructor fields - let arg_is_strict - | RealDataCon dc <- con - , isNewTyCon (dataConTyCon dc) - = [True] -- See Note [Divergence of Newtype matches] - | otherwise - = map isBanged $ conLikeImplBangs con + let arg_is_strict = map isBanged $ conLikeImplBangs con strict_arg_tys = filterByList arg_is_strict field_tys' return (ex_tvs, vars, listToBag ty_cs, strict_arg_tys) @@ -169,8 +167,8 @@ mkOneConFull arg_tys con = do ------------------------------------- -- * Composable satisfiability checks --- | Given a 'Delta', check if it is compatible with new facts encoded in this --- this check. If so, return 'Just' a potentially extended 'Delta'. Return +-- | Given a 'Nabla', check if it is compatible with new facts encoded in this +-- this check. If so, return 'Just' a potentially extended 'Nabla'. Return -- 'Nothing' if unsatisfiable. -- -- There are three essential SatisfiabilityChecks: @@ -179,22 +177,22 @@ mkOneConFull arg_tys con = do -- 3. 'tysAreNonVoid', checks if the given types have an inhabitant -- Functions like 'pmIsSatisfiable', 'nonVoid' and 'testInhabited' plug these -- together as they see fit. -newtype SatisfiabilityCheck = SC (Delta -> DsM (Maybe Delta)) +newtype SatisfiabilityCheck = SC (Nabla -> DsM (Maybe Nabla)) --- | Check the given 'Delta' for satisfiability by the given --- 'SatisfiabilityCheck'. Return 'Just' a new, potentially extended, 'Delta' if +-- | Check the given 'Nabla' for satisfiability by the given +-- 'SatisfiabilityCheck'. Return 'Just' a new, potentially extended, 'Nabla' if -- successful, and 'Nothing' otherwise. -runSatisfiabilityCheck :: Delta -> SatisfiabilityCheck -> DsM (Maybe Delta) -runSatisfiabilityCheck delta (SC chk) = chk delta +runSatisfiabilityCheck :: Nabla -> SatisfiabilityCheck -> DsM (Maybe Nabla) +runSatisfiabilityCheck nabla (SC chk) = chk nabla -- | Allowing easy composition of 'SatisfiabilityCheck's. instance Semigroup SatisfiabilityCheck where -- This is @a >=> b@ from MaybeT DsM SC a <> SC b = SC c where - c delta = a delta >>= \case + c nabla = a nabla >>= \case Nothing -> pure Nothing - Just delta' -> b delta' + Just nabla' -> b nabla' instance Monoid SatisfiabilityCheck where -- We only need this because of mconcat (which we use in place of sconcat, @@ -213,13 +211,13 @@ instance Monoid SatisfiabilityCheck where -- discussed in GADTs Meet Their Match. For an explanation of what role they -- serve, see @Note [Strict argument type constraints]@. pmIsSatisfiable - :: Delta -- ^ The ambient term and type constraints + :: Nabla -- ^ The ambient term and type constraints -- (known to be satisfiable). -> Bag TyCt -- ^ The new type constraints. -> Bag TmCt -- ^ The new term constraints. -> [Type] -- ^ The strict argument types. - -> DsM (Maybe Delta) - -- ^ @'Just' delta@ if the constraints (@delta@) are + -> DsM (Maybe Nabla) + -- ^ @'Just' nabla@ if the constraints (@nabla@) are -- satisfiable, and each strict argument type is inhabitable. -- 'Nothing' otherwise. pmIsSatisfiable amb_cs new_ty_cs new_tm_cs strict_arg_tys = @@ -492,21 +490,21 @@ tyOracle (TySt inert) cts Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } -- | A 'SatisfiabilityCheck' based on new type-level constraints. --- Returns a new 'Delta' if the new constraints are compatible with existing +-- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. Doesn't bother calling out to the type oracle if the bag of new type -- constraints was empty. Will only recheck 'PossibleMatches' in the term oracle -- for emptiness if the first argument is 'True'. tyIsSatisfiable :: Bool -> Bag PredType -> SatisfiabilityCheck -tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \delta -> +tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \nabla -> if isEmptyBag new_ty_cs - then pure (Just delta) - else tyOracle (delta_ty_st delta) new_ty_cs >>= \case + then pure (Just nabla) + else tyOracle (nabla_ty_st nabla) new_ty_cs >>= \case Nothing -> pure Nothing Just ty_st' -> do - let delta' = delta{ delta_ty_st = ty_st' } + let nabla' = nabla{ nabla_ty_st = ty_st' } if recheck_complete_sets - then ensureAllPossibleMatchesInhabited delta' - else pure (Just delta') + then ensureAllInhabited nabla' + else pure (Just nabla') {- ********************************************************************* @@ -618,21 +616,46 @@ warning messages (which can be alleviated by someone with enough dedication). -} -- | A 'SatisfiabilityCheck' based on new term-level constraints. --- Returns a new 'Delta' if the new constraints are compatible with existing +-- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. tmIsSatisfiable :: Bag TmCt -> SatisfiabilityCheck -tmIsSatisfiable new_tm_cs = SC $ \delta -> runMaybeT $ foldlM addTmCt delta new_tm_cs +tmIsSatisfiable new_tm_cs = SC $ \nabla -> runMaybeT $ foldlM addTmCt nabla new_tm_cs ----------------------- -- * Looking up VarInfo emptyVarInfo :: Id -> VarInfo -emptyVarInfo x = VI (idType x) [] emptyPmAltConSet NoPM +-- We could initialise @bot@ to @Just False@ in case of an unlifted type here, +-- but it's cleaner to let the user of the constraint solver take care of this. +-- After all, there are also strict fields, the unliftedness of which isn't +-- evident in the type. So treating unlifted types here would never be +-- sufficient anyway. +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot NoPM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' lookupVarInfo (TmSt env _) x = fromMaybe (emptyVarInfo x) (lookupSDIE env x) +-- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks +-- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the +-- returned @y@ doesn't have a positive newtype constructor constraint +-- associated with it (yet). The 'VarInfo' returned is that of @y@'s +-- representative. +-- +-- Careful, this means that @idType x@ might be different to @idType y@, even +-- modulo type normalisation! +-- +-- See also Note [Coverage checking Newtype matches]. +lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +lookupVarInfoNT ts x = case lookupVarInfo ts x of + VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y + res -> (x, res) + where + as_newtype = listToMaybe . mapMaybe go + go (PmAltConLike (RealDataCon dc), _, [y]) + | isNewDataCon dc = Just y + go _ = Nothing + initPossibleMatches :: TyState -> VarInfo -> DsM VarInfo initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do -- New evidence might lead to refined info on ty, in turn leading to discovery @@ -669,13 +692,6 @@ initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do Just cs -> pure vi{ vi_ty = ty', vi_cache = PM (mkUniqDSet <$> cs) } initPossibleMatches _ vi = pure vi --- | @initLookupVarInfo ts x@ looks up the 'VarInfo' for @x@ in @ts@ and tries --- to initialise the 'vi_cache' component if it was 'NoPM' through --- 'initPossibleMatches'. -initLookupVarInfo :: Delta -> Id -> DsM VarInfo -initLookupVarInfo MkDelta{ delta_tm_st = ts, delta_ty_st = ty_st } x - = initPossibleMatches ty_st (lookupVarInfo ts x) - {- Note [COMPLETE sets on data families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ User-defined COMPLETE sets involving data families are attached to the family @@ -720,22 +736,11 @@ TyCon, so tc_rep = tc_fam afterwards. -} ------------------------------------------------ --- * Exported utility functions querying 'Delta' +-- * Exported utility functions querying 'Nabla' --- | Check whether adding a constraint @x ~ BOT@ to 'Delta' succeeds. -canDiverge :: Delta -> Id -> Bool -canDiverge delta at MkDelta{ delta_tm_st = ts } x - | VI _ pos neg _ <- lookupVarInfo ts x - = isEmptyPmAltConSet neg && all pos_can_diverge pos - where - pos_can_diverge (PmAltConLike (RealDataCon dc), _, [y]) - -- See Note [Divergence of Newtype matches] - | isNewTyCon (dataConTyCon dc) = canDiverge delta y - pos_can_diverge _ = False - -{- Note [Divergence of Newtype matches] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Newtypes behave rather strangely when compared to ordinary DataCons. In a +{- Note [Coverage checking Newtype matches] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Newtypes have quite peculiar match semantics compared to ordinary DataCons. In a pattern-match, they behave like a irrefutable (lazy) match, but for inhabitation testing purposes (e.g. at construction sites), they behave rather like a DataCon with a *strict* field, because they don't contribute their own bottom and are @@ -750,19 +755,21 @@ This distinction becomes apparent in #17248: If we treat Newtypes like we treat regular DataCons, we would mark the third clause as redundant, which clearly is unsound. The solution: -1. When compiling the PmCon guard in 'pmCompileTree', don't add a @DivergeIf@, - because the match will never diverge. -2. Regard @T2 x@ as 'canDiverge' iff @x@ 'canDiverge'. E.g. @T2 x ~ _|_@ <=> - @x ~ _|_ at . This way, the third clause will still be marked as inaccessible - RHS instead of redundant. -3. When testing for inhabitants ('mkOneConFull'), we regard the newtype field as - strict, so that the newtype is inhabited iff its field is inhabited. +1. 'isPmAltConMatchStrict' returns False for newtypes, indicating that a + newtype match is lazy. +2. When we find @x ~ T2 y@, transfer all constraints on @x@ (which involve @⊥@) + to @y@, similar to what 'equate' does, and don't add a @x /~ ⊥@ constraint. + This way, the third clause will still be marked as inaccessible RHS instead + of redundant. This is ensured by calling 'lookupVarInfoNT'. +3. Immediately reject when we find @x /~ T2 at . +Handling of Newtypes is also described in the Appendix of the Lower Your Guards paper, +where you can find the solution in a perhaps more digestible format. -} -lookupRefuts :: Uniquable k => Delta -> k -> [PmAltCon] +lookupRefuts :: Uniquable k => Nabla -> k -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. -lookupRefuts MkDelta{ delta_tm_st = ts@(TmSt (SDIE env) _) } k = +lookupRefuts MkNabla{ nabla_tm_st = ts@(TmSt (SDIE env) _) } k = case lookupUDFM_Directly env (getUnique k) of Nothing -> [] Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y)) @@ -772,10 +779,10 @@ isDataConSolution :: (PmAltCon, [TyVar], [Id]) -> Bool isDataConSolution (PmAltConLike (RealDataCon _), _, _) = True isDataConSolution _ = False --- @lookupSolution delta x@ picks a single solution ('vi_pos') of @x@ from +-- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. -lookupSolution :: Delta -> Id -> Maybe (PmAltCon, [TyVar], [Id]) -lookupSolution delta x = case vi_pos (lookupVarInfo (delta_tm_st delta) x) of +lookupSolution :: Nabla -> Id -> Maybe (PmAltCon, [TyVar], [Id]) +lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of [] -> Nothing pos | Just sol <- find isDataConSolution pos -> Just sol @@ -842,13 +849,13 @@ instance Outputable PmCt where ppr (PmTyCt pred_ty) = ppr pred_ty ppr (PmTmCt tm_ct) = ppr tm_ct --- | Adds new constraints to 'Delta' and returns 'Nothing' if that leads to a +-- | Adds new constraints to 'Nabla' and returns 'Nothing' if that leads to a -- contradiction. -addPmCts :: Delta -> PmCts -> DsM (Maybe Delta) +addPmCts :: Nabla -> PmCts -> DsM (Maybe Nabla) -- See Note [TmState invariants]. -addPmCts delta cts = do +addPmCts nabla cts = do let (ty_cts, tm_cts) = partitionTyTmCts cts - runSatisfiabilityCheck delta $ mconcat + runSatisfiabilityCheck nabla $ mconcat [ tyIsSatisfiable True (listToBag ty_cts) , tmIsSatisfiable (listToBag tm_cts) ] @@ -861,44 +868,40 @@ partitionTyTmCts = partitionEithers . map to_either . toList -- | Adds a single term constraint by dispatching to the various term oracle -- functions. -addTmCt :: Delta -> TmCt -> MaybeT DsM Delta -addTmCt delta (TmVarCt x y) = addVarCt delta x y -addTmCt delta (TmCoreCt x e) = addCoreCt delta x e -addTmCt delta (TmConCt x con tvs args) = addConCt delta x con tvs args -addTmCt delta (TmNotConCt x con) = addNotConCt delta x con -addTmCt delta (TmBotCt x) = addBotCt delta x -addTmCt delta (TmNotBotCt x) = addNotBotCt delta x +addTmCt :: Nabla -> TmCt -> MaybeT DsM Nabla +addTmCt nabla (TmVarCt x y) = addVarCt nabla x y +addTmCt nabla (TmCoreCt x e) = addCoreCt nabla x e +addTmCt nabla (TmConCt x con tvs args) = addConCt nabla x con tvs args +addTmCt nabla (TmNotConCt x con) = addNotConCt nabla x con +addTmCt nabla (TmBotCt x) = addBotCt nabla x +addTmCt nabla (TmNotBotCt x) = addNotBotCt nabla x -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ --- surely diverges. --- --- Only that's a lie, because we don't currently preserve the fact in 'Delta' --- after we checked compatibility. See Note [Preserving TmBotCt] -addBotCt :: Delta -> Id -> MaybeT DsM Delta -addBotCt delta x - | canDiverge delta x = pure delta - | otherwise = mzero - -{- Note [Preserving TmBotCt] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Whenever we add a new constraint to 'Delta' via 'addTmCt', we want to check it -for compatibility with existing constraints in the modeled indert set and then -add it the constraint itself to the inert set. -For a 'TmBotCt' @x ~ ⊥@ we don't actually add it to the inert set after checking -it for compatibility with 'Delta'. -And that is fine in the context of the patter-match checking algorithm! -Whenever we add a 'TmBotCt' (we only do so for checking divergence of bang -patterns and strict constructor matches), we don't add any more constraints to -the inert set afterwards, so we don't need to preserve it. --} +-- surely diverges. Quite similar to 'addConCt', only that it only cares about +-- ⊥. +addBotCt :: Nabla -> Id -> MaybeT DsM Nabla +addBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do + let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + case bot of + IsNotBot -> mzero -- There was x /~ ⊥. Contradiction! + IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do + MaybeBot -> do -- We add x ~ ⊥ + let vi' = vi{ vi_bot = IsBot } + pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env y vi') reps} -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't --- take the shape of a 'PmAltCon' @K@ in the 'Delta' and return @Nothing@ if +-- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if -- that leads to a contradiction. -- See Note [TmState invariants]. -addNotConCt :: Delta -> Id -> PmAltCon -> MaybeT DsM Delta -addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do - vi@(VI _ pos neg pm) <- lift (initLookupVarInfo delta x) +addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla +addNotConCt _ _ (PmAltConLike (RealDataCon dc)) + | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] +addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do + -- For good performance, it's important to initPossibleMatches here. + -- Otherwise we can't mark nalt as matched later on, incurring unnecessary + -- inhabitation tests for nalt. + vi@(VI _ pos neg _ pm) <- lift $ initPossibleMatches (nabla_ty_st nabla) + (lookupVarInfo ts x) -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt (cl, _tvs, _args) = eqPmAltCon cl nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -910,13 +913,14 @@ addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do -- See Note [Completeness checking with required Thetas] | hasRequiredTheta nalt = neg | otherwise = extendPmAltConSet neg nalt - let vi_ext = vi{ vi_neg = neg' } + MASSERT( isPmAltConMatchStrict nalt ) + let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor - vi' <- case nalt of + vi2 <- case nalt of PmAltConLike cl - -> MaybeT (ensureInhabited delta vi_ext{ vi_cache = markMatched cl pm }) - _ -> pure vi_ext - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x vi') reps } + -> ensureInhabited nabla vi1{ vi_cache = markMatched cl pm } + _ -> pure vi1 + pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -979,100 +983,104 @@ guessConLikeUnivTyArgsFromResTy _ res_ty (PatSynCon ps) = do subst <- tcMatchTy con_res_ty res_ty traverse (lookupTyVar subst) univ_tvs --- | Adds the constraint @x ~/ ⊥@ to 'Delta'. +-- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', +-- but only cares for the ⊥ "constructor". +addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla +addNotBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do + let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + case bot of + IsBot -> mzero -- There was x ~ ⊥. Contradiction! + IsNotBot -> pure nabla -- There already is x /~ ⊥. Nothing left to do + MaybeBot -> do -- We add x /~ ⊥ and test if x is still inhabited + vi <- ensureInhabited nabla vi{ vi_bot = IsNotBot } + pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env y vi) reps} + +-- | Returns (Just vi) if at least one member of each ConLike in the COMPLETE +-- set satisfies the oracle +-- +-- Internally uses and updates the ConLikeSets in vi_cache. -- --- But doesn't really commit to upholding that constraint in the future. This --- will be rectified in a follow-up patch. The status quo should work good --- enough for now. -addNotBotCt :: Delta -> Id -> MaybeT DsM Delta -addNotBotCt delta at MkDelta{ delta_tm_st = TmSt env reps } x = do - vi <- lift $ initLookupVarInfo delta x - vi' <- MaybeT $ ensureInhabited delta vi - -- vi' has probably constructed and then thinned out some PossibleMatches. - -- We want to cache that work - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x vi') reps} - -ensureInhabited :: Delta -> VarInfo -> DsM (Maybe VarInfo) - -- Returns (Just vi) if at least one member of each ConLike in the COMPLETE - -- set satisfies the oracle - -- - -- Internally uses and updates the ConLikeSets in vi_cache. - -- - -- NB: Does /not/ filter each ConLikeSet with the oracle; members may - -- remain that do not statisfy it. This lazy approach just - -- avoids doing unnecessary work. -ensureInhabited delta vi = fmap (set_cache vi) <$> test (vi_cache vi) -- This would be much less tedious with lenses +-- NB: Does /not/ filter each ConLikeSet with the oracle; members may +-- remain that do not statisfy it. This lazy approach just +-- avoids doing unnecessary work. +ensureInhabited :: Nabla -> VarInfo -> MaybeT DsM VarInfo +ensureInhabited nabla vi = case vi_bot vi of + MaybeBot -> pure vi -- The |-Bot rule from the paper + IsBot -> pure vi + IsNotBot -> lift (initPossibleMatches (nabla_ty_st nabla) vi) >>= inst_complete_sets where - set_cache vi cache = vi { vi_cache = cache } - - test NoPM = pure (Just NoPM) - test (PM ms) = runMaybeT (PM <$> traverse one_set ms) - - one_set cs = find_one_inh cs (uniqDSetToList cs) - - find_one_inh :: ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet - -- (find_one_inh cs cls) iterates over cls, deleting from cs + -- | This is the |-Inst rule from the paper (section 4.5). Tries to + -- find an inhabitant in every complete set by instantiating with one their + -- constructors. If there is any complete set where we can't find an + -- inhabitant, the whole thing is uninhabited. + inst_complete_sets :: VarInfo -> MaybeT DsM VarInfo + inst_complete_sets vi at VI{ vi_cache = NoPM } = pure vi + inst_complete_sets vi at VI{ vi_cache = PM ms } = do + ms <- traverse (\cs -> inst_complete_set vi cs (uniqDSetToList cs)) ms + pure vi{ vi_cache = PM ms } + + inst_complete_set :: VarInfo -> ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet + -- (inst_complete_set cs cls) iterates over cls, deleting from cs -- any uninhabited elements of cls. Stop (returning Just cs) -- when you see an inhabited element; return Nothing if all -- are uninhabited - find_one_inh _ [] = mzero - find_one_inh cs (con:cons) = lift (inh_test con) >>= \case + inst_complete_set _ _ [] = mzero + inst_complete_set vi cs (con:cons) = lift (inst_and_test vi con) >>= \case True -> pure cs - False -> find_one_inh (delOneFromUniqDSet cs con) cons + False -> inst_complete_set vi (delOneFromUniqDSet cs con) cons - inh_test :: ConLike -> DsM Bool - -- @inh_test K@ Returns False if a non-bottom value @v::ty@ cannot possibly + inst_and_test :: VarInfo -> ConLike -> DsM Bool + -- @inst_and_test K@ Returns False if a non-bottom value @v::ty@ cannot possibly -- be of form @K _ _ _ at . Returning True is always sound. -- -- It's like 'DataCon.dataConCannotMatch', but more clever because it takes - -- the facts in Delta into account. - inh_test con = do + -- the facts in Nabla into account. + inst_and_test vi con = do env <- dsGetFamInstEnvs case guessConLikeUnivTyArgsFromResTy env (vi_ty vi) con of Nothing -> pure True -- be conservative about this Just arg_tys -> do (_tvs, _vars, ty_cs, strict_arg_tys) <- mkOneConFull arg_tys con - tracePm "inh_test" (ppr con $$ ppr ty_cs) + tracePm "inst_and_test" (ppr con $$ ppr ty_cs) -- No need to run the term oracle compared to pmIsSatisfiable - fmap isJust <$> runSatisfiabilityCheck delta $ mconcat + fmap isJust <$> runSatisfiabilityCheck nabla $ mconcat -- Important to pass False to tyIsSatisfiable here, so that we won't - -- recursively call ensureAllPossibleMatchesInhabited, leading to an + -- recursively call ensureAllInhabited, leading to an -- endless recursion. [ tyIsSatisfiable False ty_cs , tysAreNonVoid initRecTc strict_arg_tys ] -- | Checks if every 'VarInfo' in the term oracle has still an inhabited --- 'vi_cache', considering the current type information in 'Delta'. +-- 'vi_cache', considering the current type information in 'Nabla'. -- This check is necessary after having matched on a GADT con to weed out -- impossible matches. -ensureAllPossibleMatchesInhabited :: Delta -> DsM (Maybe Delta) -ensureAllPossibleMatchesInhabited delta at MkDelta{ delta_tm_st = TmSt env reps } - = runMaybeT (set_tm_cs_env delta <$> traverseSDIE go env) +ensureAllInhabited :: Nabla -> DsM (Maybe Nabla) +ensureAllInhabited nabla at MkNabla{ nabla_tm_st = TmSt env reps } + = runMaybeT (set_tm_cs_env nabla <$> traverseSDIE go env) where - set_tm_cs_env delta env = delta{ delta_tm_st = TmSt env reps } - go vi = MaybeT $ - initPossibleMatches (delta_ty_st delta) vi >>= ensureInhabited delta + set_tm_cs_env nabla env = nabla{ nabla_tm_st = TmSt env reps } + go vi = ensureInhabited nabla vi -------------------------------------- -- * Term oracle unification procedure -- | Adds a @x ~ y@ constraint by trying to unify two 'Id's and record the --- gained knowledge in 'Delta'. +-- gained knowledge in 'Nabla'. -- --- Returns @Nothing@ when there's a contradiction. Returns @Just delta@ --- when the constraint was compatible with prior facts, in which case @delta@ +-- Returns @Nothing@ when there's a contradiction. Returns @Just nabla@ +-- when the constraint was compatible with prior facts, in which case @nabla@ -- has integrated the knowledge from the equality constraint. -- -- See Note [TmState invariants]. -addVarCt :: Delta -> Id -> Id -> MaybeT DsM Delta -addVarCt delta at MkDelta{ delta_tm_st = TmSt env _ } x y +addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +addVarCt nabla at MkNabla{ nabla_tm_st = TmSt env _ } x y -- It's important that we never @equate@ two variables of the same equivalence -- class, otherwise we might get cyclic substitutions. -- Cf. 'extendSubstAndSolve' and -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . - | sameRepresentativeSDIE env x y = pure delta - | otherwise = equate delta x y + | sameRepresentativeSDIE env x y = pure nabla + | otherwise = equate nabla x y -- | @equate ts@(TmSt env) x y@ merges the equivalence classes of @x@ and @y@ by -- adding an indirection to the environment. @@ -1081,12 +1089,12 @@ addVarCt delta at MkDelta{ delta_tm_st = TmSt env _ } x y -- Preconditions: @not (sameRepresentativeSDIE env x y)@ -- -- See Note [TmState invariants]. -equate :: Delta -> Id -> Id -> MaybeT DsM Delta -equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y +equate :: Nabla -> Id -> Id -> MaybeT DsM Nabla +equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y = ASSERT( not (sameRepresentativeSDIE env x y) ) case (lookupSDIE env x, lookupSDIE env y) of - (Nothing, _) -> pure (delta{ delta_tm_st = TmSt (setIndirectSDIE env x y) reps }) - (_, Nothing) -> pure (delta{ delta_tm_st = TmSt (setIndirectSDIE env y x) reps }) + (Nothing, _) -> pure (nabla{ nabla_tm_st = TmSt (setIndirectSDIE env x y) reps }) + (_, Nothing) -> pure (nabla{ nabla_tm_st = TmSt (setIndirectSDIE env y x) reps }) -- Merge the info we have for x into the info for y (Just vi_x, Just vi_y) -> do -- This assert will probably trigger at some point... @@ -1096,16 +1104,16 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y let env_ind = setIndirectSDIE env x y -- Then sum up the refinement counters let env_refs = setEntrySDIE env_ind y vi_y - let delta_refs = delta{ delta_tm_st = TmSt env_refs reps } + let nabla_refs = nabla{ nabla_tm_st = TmSt env_refs reps } -- and then gradually merge every positive fact we have on x into y - let add_fact delta (cl, tvs, args) = addConCt delta y cl tvs args - delta_pos <- foldlM add_fact delta_refs (vi_pos vi_x) + let add_fact nabla (cl, tvs, args) = addConCt nabla y cl tvs args + nabla_pos <- foldlM add_fact nabla_refs (vi_pos vi_x) -- Do the same for negative info - let add_refut delta nalt = addNotConCt delta y nalt - delta_neg <- foldlM add_refut delta_pos (pmAltConSetElems (vi_neg vi_x)) + let add_refut nabla nalt = addNotConCt nabla y nalt + nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) -- vi_cache will be updated in addNotConCt, so we are good to -- go! - pure delta_neg + pure nabla_neg -- | Add a @x ~ K tvs args ts@ constraint. -- @addConCt x K tvs args ts@ extends the substitution with a solution @@ -1113,9 +1121,9 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y -- have on @x@, reject (@Nothing@) otherwise. -- -- See Note [TmState invariants]. -addConCt :: Delta -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Delta -addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do - VI ty pos neg cache <- lift (initLookupVarInfo delta x) +addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla +addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do + let VI ty pos neg bot cache = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -1131,10 +1139,19 @@ addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do when (length args /= length other_args) $ lift $ tracePm "error" (ppr x <+> ppr alt <+> ppr args <+> ppr other_args) let tm_cts = zipWithEqual "addConCt" PmVarCt args other_args - MaybeT $ addPmCts delta (listToBag ty_cts `unionBags` listToBag tm_cts) + MaybeT $ addPmCts nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = (alt, tvs, args):pos - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg cache)) reps} + let nabla_with bot = nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot cache)) reps} + -- Do (2) in Note [Coverage checking Newtype matches] + case (alt, args) of + (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> + case bot of + MaybeBot -> pure (nabla_with MaybeBot) + IsBot -> addBotCt (nabla_with MaybeBot) y + IsNotBot -> addNotBotCt (nabla_with MaybeBot) y + _ -> ASSERT( isPmAltConMatchStrict alt ) + pure (nabla_with IsNotBot) -- strict match ==> not ⊥ equateTys :: [Type] -> [Type] -> [PmCt] equateTys ts us = @@ -1183,9 +1200,9 @@ mkInhabitationCandidate x dc = do -- if it can. In this case, the candidates are the signature of the tycon, each -- one accompanied by the term- and type- constraints it gives rise to. -- See also Note [Checking EmptyCase Expressions] -inhabitationCandidates :: Delta -> Type +inhabitationCandidates :: Nabla -> Type -> DsM (Either Type (TyCon, Id, [InhabitationCandidate])) -inhabitationCandidates MkDelta{ delta_ty_st = ty_st } ty = do +inhabitationCandidates MkNabla{ nabla_ty_st = ty_st } ty = do pmTopNormaliseType ty_st ty >>= \case NoChange _ -> alts_to_check ty ty [] NormalisedByConstraints ty' -> alts_to_check ty' ty' [] @@ -1281,20 +1298,20 @@ we do the following: -- | A 'SatisfiabilityCheck' based on "NonVoid ty" constraints, e.g. Will -- check if the @strict_arg_tys@ are actually all inhabited. --- Returns the old 'Delta' if all the types are non-void according to 'Delta'. +-- Returns the old 'Nabla' if all the types are non-void according to 'Nabla'. tysAreNonVoid :: RecTcChecker -> [Type] -> SatisfiabilityCheck -tysAreNonVoid rec_env strict_arg_tys = SC $ \delta -> do - all_non_void <- checkAllNonVoid rec_env delta strict_arg_tys +tysAreNonVoid rec_env strict_arg_tys = SC $ \nabla -> do + all_non_void <- checkAllNonVoid rec_env nabla strict_arg_tys -- Check if each strict argument type is inhabitable pure $ if all_non_void - then Just delta + then Just nabla else Nothing -- | Implements two performance optimizations, as described in -- @Note [Strict argument type constraints]@. -checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> DsM Bool +checkAllNonVoid :: RecTcChecker -> Nabla -> [Type] -> DsM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - let definitely_inhabited = definitelyInhabitedType (delta_ty_st amb_cs) + let definitely_inhabited = definitelyInhabitedType (nabla_ty_st amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys -- See Note [Fuel for the inhabitation test] let rec_max_bound | tys_to_check `lengthExceeds` 1 @@ -1309,7 +1326,7 @@ checkAllNonVoid rec_ts amb_cs strict_arg_tys = do -- See @Note [Strict argument type constraints]@. nonVoid :: RecTcChecker -- ^ The per-'TyCon' recursion depth limit. - -> Delta -- ^ The ambient term/type constraints (known to be + -> Nabla -- ^ The ambient term/type constraints (known to be -- satisfiable). -> Type -- ^ The strict argument type. -> DsM Bool -- ^ 'True' if the strict argument type might be inhabited by @@ -1337,7 +1354,7 @@ nonVoid rec_ts amb_cs strict_arg_ty = do -- check if recursion is detected). -- -- See Note [Strict argument type constraints] - cand_is_inhabitable :: RecTcChecker -> Delta + cand_is_inhabitable :: RecTcChecker -> Nabla -> InhabitationCandidate -> DsM Bool cand_is_inhabitable rec_ts amb_cs (InhabitationCandidate{ ic_cs = new_cs @@ -1516,21 +1533,21 @@ on a list of strict argument types, we filter out all of the DI ones. -} -------------------------------------------- --- * Providing positive evidence for a Delta +-- * Providing positive evidence for a Nabla --- | @provideEvidence vs n delta@ returns a list of --- at most @n@ (but perhaps empty) refinements of @delta@ that instantiate +-- | @provideEvidence vs n nabla@ returns a list of +-- at most @n@ (but perhaps empty) refinements of @nabla@ that instantiate -- @vs@ to compatible constructor applications or wildcards. -- Negative information is only retained if literals are involved or when -- for recursive GADTs. -provideEvidence :: [Id] -> Int -> Delta -> DsM [Delta] +provideEvidence :: [Id] -> Int -> Nabla -> DsM [Nabla] provideEvidence = go where go _ 0 _ = pure [] - go [] _ delta = pure [delta] - go (x:xs) n delta = do - tracePm "provideEvidence" (ppr x $$ ppr xs $$ ppr delta $$ ppr n) - VI _ pos neg _ <- initLookupVarInfo delta x + go [] _ nabla = pure [nabla] + go (x:xs) n nabla = do + tracePm "provideEvidence" (ppr x $$ ppr xs $$ ppr nabla $$ ppr n) + let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x case pos of _:_ -> do -- All solutions must be valid at once. Try to find candidates for their @@ -1543,56 +1560,57 @@ provideEvidence = go -- some @y@ and @SomePatSyn z@ for some @z at . We must find evidence for @y@ -- and @z@ that is valid at the same time. These constitute arg_vas below. let arg_vas = concatMap (\(_cl, _tvs, args) -> args) pos - go (arg_vas ++ xs) n delta + go (arg_vas ++ xs) n nabla [] -- When there are literals involved, just print negative info -- instead of listing missed constructors | notNull [ l | PmAltLit l <- pmAltConSetElems neg ] - -> go xs n delta - [] -> try_instantiate x xs n delta + -> go xs n nabla + [] -> try_instantiate x xs n nabla -- | Tries to instantiate a variable by possibly following the chain of -- newtypes and then instantiating to all ConLikes of the wrapped type's -- minimal residual COMPLETE set. - try_instantiate :: Id -> [Id] -> Int -> Delta -> DsM [Delta] + try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. - try_instantiate x xs n delta = do - (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (delta_ty_st delta) (idType x) - let build_newtype (x, delta) (_ty, dc, arg_ty) = do + try_instantiate x xs n nabla = do + (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + let build_newtype (x, nabla) (_ty, dc, arg_ty) = do y <- lift $ mkPmId arg_ty -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - delta' <- addConCt delta x (PmAltConLike (RealDataCon dc)) [] [y] - pure (y, delta') - runMaybeT (foldlM build_newtype (x, delta) dcs) >>= \case + nabla' <- addConCt nabla x (PmAltConLike (RealDataCon dc)) [] [y] + pure (y, nabla') + runMaybeT (foldlM build_newtype (x, nabla) dcs) >>= \case Nothing -> pure [] - Just (y, newty_delta) -> do + Just (y, newty_nabla) -> do -- Pick a COMPLETE set and instantiate it (n at max). Take care of ⊥. - pm <- vi_cache <$> initLookupVarInfo newty_delta y - mb_cls <- pickMinimalCompleteSet newty_delta pm + let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + vi <- initPossibleMatches (nabla_ty_st newty_nabla) vi + mb_cls <- pickMinimalCompleteSet newty_nabla (vi_cache vi) case uniqDSetToList <$> mb_cls of - Just cls@(_:_) -> instantiate_cons y core_ty xs n newty_delta cls - Just [] | not (canDiverge newty_delta y) -> pure [] + Just cls@(_:_) -> instantiate_cons y core_ty xs n newty_nabla cls + Just [] | vi_bot vi == IsNotBot -> pure [] -- Either ⊥ is still possible (think Void) or there are no COMPLETE -- sets available, so we can assume it's inhabited - _ -> go xs n newty_delta + _ -> go xs n newty_nabla - instantiate_cons :: Id -> Type -> [Id] -> Int -> Delta -> [ConLike] -> DsM [Delta] + instantiate_cons :: Id -> Type -> [Id] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] instantiate_cons _ _ _ 0 _ _ = pure [] - instantiate_cons _ ty xs n delta _ + instantiate_cons _ ty xs n nabla _ -- We don't want to expose users to GHC-specific constructors for Int etc. | fmap (isTyConTriviallyInhabited . fst) (splitTyConApp_maybe ty) == Just True - = go xs n delta - instantiate_cons x ty xs n delta (cl:cls) = do + = go xs n nabla + instantiate_cons x ty xs n nabla (cl:cls) = do env <- dsGetFamInstEnvs case guessConLikeUnivTyArgsFromResTy env ty cl of - Nothing -> pure [delta] -- No idea how to refine this one, so just finish off with a wildcard + Nothing -> pure [nabla] -- No idea how to refine this one, so just finish off with a wildcard Just arg_tys -> do (tvs, arg_vars, new_ty_cs, strict_arg_tys) <- mkOneConFull arg_tys cl let new_tm_cs = unitBag (TmConCt x (PmAltConLike cl) tvs arg_vars) -- Now check satifiability - mb_delta <- pmIsSatisfiable delta new_ty_cs new_tm_cs strict_arg_tys + mb_nabla <- pmIsSatisfiable nabla new_ty_cs new_tm_cs strict_arg_tys tracePm "instantiate_cons" (vcat [ ppr x , ppr (idType x) , ppr ty @@ -1601,21 +1619,21 @@ provideEvidence = go , ppr new_tm_cs , ppr new_ty_cs , ppr strict_arg_tys - , ppr delta - , ppr mb_delta + , ppr nabla + , ppr mb_nabla , ppr n ]) - con_deltas <- case mb_delta of + con_nablas <- case mb_nabla of Nothing -> pure [] -- NB: We don't prepend arg_vars as we don't have any evidence on -- them and we only want to split once on a data type. They are -- inhabited, otherwise pmIsSatisfiable would have refuted. - Just delta' -> go xs n delta' - other_cons_deltas <- instantiate_cons x ty xs (n - length con_deltas) delta cls - pure (con_deltas ++ other_cons_deltas) + Just nabla' -> go xs n nabla' + other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls + pure (con_nablas ++ other_cons_nablas) -pickMinimalCompleteSet :: Delta -> PossibleMatches -> DsM (Maybe ConLikeSet) +pickMinimalCompleteSet :: Nabla -> PossibleMatches -> DsM (Maybe ConLikeSet) pickMinimalCompleteSet _ NoPM = pure Nothing --- TODO: First prune sets with type info in delta. But this is good enough for +-- TODO: First prune sets with type info in nabla. But this is good enough for -- now and less costly. See #17386. pickMinimalCompleteSet _ (PM clss) = do tracePm "pickMinimalCompleteSet" (ppr $ NonEmpty.toList clss) @@ -1625,14 +1643,14 @@ pickMinimalCompleteSet _ (PM clss) = do -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically -- equivalent to @e'@) we encountered earlier, or a fresh identifier if -- there weren't any such constraints. -representCoreExpr :: Delta -> CoreExpr -> DsM (Delta, Id) -representCoreExpr delta at MkDelta{ delta_tm_st = ts at TmSt{ ts_reps = reps } } e - | Just rep <- lookupCoreMap reps e = pure (delta, rep) +representCoreExpr :: Nabla -> CoreExpr -> DsM (Nabla, Id) +representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e + | Just rep <- lookupCoreMap reps e = pure (nabla, rep) | otherwise = do rep <- mkPmId (exprType e) let reps' = extendCoreMap reps e rep - let delta' = delta{ delta_tm_st = ts{ ts_reps = reps' } } - pure (delta', rep) + let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } + pure (nabla', rep) -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -1646,16 +1664,16 @@ representCoreExpr delta at MkDelta{ delta_tm_st = ts at TmSt{ ts_reps = reps } } e -- for other literals. See 'coreExprAsPmLit'. -- * Finally, if we have @let x = e@ and we already have seen @let y = e@, we -- want to record @x ~ y at . -addCoreCt :: Delta -> Id -> CoreExpr -> MaybeT DsM Delta -addCoreCt delta x e = do +addCoreCt :: Nabla -> Id -> CoreExpr -> MaybeT DsM Nabla +addCoreCt nabla x e = do dflags <- getDynFlags let e' = simpleOptExpr dflags e - lift $ tracePm "addCoreCt" (ppr x <+> dcolon <+> ppr (idType x) $$ ppr e $$ ppr e') - execStateT (core_expr x e') delta + -- lift $ tracePm "addCoreCt" (ppr x <+> dcolon <+> ppr (idType x) $$ ppr e $$ ppr e') + execStateT (core_expr x e') nabla where -- | Takes apart a 'CoreExpr' and tries to extract as much information about -- literals and constructor applications as possible. - core_expr :: Id -> CoreExpr -> StateT Delta (MaybeT DsM) () + core_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () -- TODO: Handle newtypes properly, by wrapping the expression in a DataCon -- This is the right thing for casts involving data family instances and -- their representation TyCon, though (which are not visible in source @@ -1680,7 +1698,7 @@ addCoreCt delta x e = do -- See Note [Detecting pattern synonym applications in expressions] | Var y <- e, Nothing <- isDataConId_maybe x -- We don't consider DataCons flexible variables - = modifyT (\delta -> addVarCt delta x y) + = modifyT (\nabla -> addVarCt nabla x y) | otherwise -- Any other expression. Try to find other uses of a semantically -- equivalent expression and represent them by the same variable! @@ -1698,13 +1716,13 @@ addCoreCt delta x e = do -- see if we already encountered a constraint @let y = e'@ with @e'@ -- semantically equivalent to @e@, in which case we may add the constraint -- @x ~ y at . - equate_with_similar_expr :: Id -> CoreExpr -> StateT Delta (MaybeT DsM) () + equate_with_similar_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () equate_with_similar_expr x e = do - rep <- StateT $ \delta -> swap <$> lift (representCoreExpr delta e) + rep <- StateT $ \nabla -> swap <$> lift (representCoreExpr nabla e) -- Note that @rep == x@ if we encountered @e@ for the first time. - modifyT (\delta -> addVarCt delta x rep) + modifyT (\nabla -> addVarCt nabla x rep) - bind_expr :: CoreExpr -> StateT Delta (MaybeT DsM) Id + bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id bind_expr e = do x <- lift (lift (mkPmId (exprType e))) core_expr x e @@ -1712,10 +1730,12 @@ addCoreCt delta x e = do -- | Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): - -- 1. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i@ - -- 2. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ - -- 3. @x ~ K as ys@ - data_con_app :: Id -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Delta (MaybeT DsM) () + -- 1. @x /~ ⊥@ if 'K' is not a Newtype constructor. + -- 2. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i@ + -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ + -- 4. @x ~ K as ys@ + -- This is quite similar to PmCheck.pmConCts. + data_con_app :: Id -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Nabla (MaybeT DsM) () data_con_app x in_scope dc args = do let dc_ex_tvs = dataConExTyCoVars dc arty = dataConSourceArity dc @@ -1725,20 +1745,27 @@ addCoreCt delta x e = do uniq_supply <- lift $ lift $ getUniqueSupplyM let (_, ex_tvs) = cloneTyVarBndrs (mkEmptyTCvSubst in_scope) dc_ex_tvs uniq_supply ty_cts = equateTys (map mkTyVarTy ex_tvs) ex_tys - -- 1. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i at . See also #17703 - modifyT $ \delta -> MaybeT $ addPmCts delta (listToBag ty_cts) - -- 2. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ + -- 1. @x /~ ⊥@ if 'K' is not a Newtype constructor (#18341) + when (not (isNewDataCon dc)) $ + modifyT $ \nabla -> addNotBotCt nabla x + -- 2. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i at . See also #17703 + modifyT $ \nabla -> MaybeT $ addPmCts nabla (listToBag ty_cts) + -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ arg_ids <- traverse bind_expr vis_args - -- 3. @x ~ K as ys@ + -- 4. @x ~ K as ys@ pm_alt_con_app x (PmAltConLike (RealDataCon dc)) ex_tvs arg_ids -- | Adds a literal constraint, i.e. @x ~ 42 at . - pm_lit :: Id -> PmLit -> StateT Delta (MaybeT DsM) () - pm_lit x lit = pm_alt_con_app x (PmAltLit lit) [] [] + -- Also we assume that literal expressions won't diverge, so this + -- will add a @x ~/ ⊥@ constraint. + pm_lit :: Id -> PmLit -> StateT Nabla (MaybeT DsM) () + pm_lit x lit = do + modifyT $ \nabla -> addNotBotCt nabla x + pm_alt_con_app x (PmAltLit lit) [] [] -- | Adds the given constructor application as a solution for @x at . - pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Delta (MaybeT DsM) () - pm_alt_con_app x con tvs args = modifyT $ \delta -> addConCt delta x con tvs args + pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Nabla (MaybeT DsM) () + pm_alt_con_app x con tvs args = modifyT $ \nabla -> addConCt nabla x con tvs args -- | Like 'modify', but with an effectful modifier action modifyT :: Monad m => (s -> m s) -> StateT s m () ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} --- | Provides factilities for pretty-printing 'Delta's in a way appropriate for +-- | Provides factilities for pretty-printing 'Nabla's in a way appropriate for -- user facing pattern match warnings. module GHC.HsToCore.PmCheck.Ppr ( pprUncovered @@ -42,8 +42,8 @@ import GHC.HsToCore.PmCheck.Oracle -- -- When the set of refutable shapes contains more than 3 elements, the -- additional elements are indicated by "...". -pprUncovered :: Delta -> [Id] -> SDoc -pprUncovered delta vas +pprUncovered :: Nabla -> [Id] -> SDoc +pprUncovered nabla vas | isNullUDFM refuts = fsep vec -- there are no refutations | otherwise = hang (fsep vec) 4 $ text "where" <+> vcat (map (pprRefutableShapes . snd) (udfmToList refuts)) @@ -54,8 +54,8 @@ pprUncovered delta vas | [_] <- vas = topPrec | otherwise = appPrec ppr_action = mapM (pprPmVar init_prec) vas - (vec, renamings) = runPmPpr delta ppr_action - refuts = prettifyRefuts delta renamings + (vec, renamings) = runPmPpr nabla ppr_action + refuts = prettifyRefuts nabla renamings -- | Output refutable shapes of a variable in the form of @var is not one of {2, -- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is @@ -98,21 +98,21 @@ substitution to the vectors before printing them out (see function `pprOne' in -- | Extract and assigns pretty names to constraint variables with refutable -- shapes. -prettifyRefuts :: Delta -> DIdEnv SDoc -> DIdEnv (SDoc, [PmAltCon]) -prettifyRefuts delta = listToUDFM_Directly . map attach_refuts . udfmToList +prettifyRefuts :: Nabla -> DIdEnv SDoc -> DIdEnv (SDoc, [PmAltCon]) +prettifyRefuts nabla = listToUDFM_Directly . map attach_refuts . udfmToList where - attach_refuts (u, sdoc) = (u, (sdoc, lookupRefuts delta u)) + attach_refuts (u, sdoc) = (u, (sdoc, lookupRefuts nabla u)) -type PmPprM a = RWS Delta () (DIdEnv SDoc, [SDoc]) a +type PmPprM a = RWS Nabla () (DIdEnv SDoc, [SDoc]) a -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ [ text ('t':show u) | u <- [(0 :: Int)..] ] -runPmPpr :: Delta -> PmPprM a -> (a, DIdEnv SDoc) -runPmPpr delta m = case runRWS m delta (emptyDVarEnv, nameList) of +runPmPpr :: Nabla -> PmPprM a -> (a, DIdEnv SDoc) +runPmPpr nabla m = case runRWS m nabla (emptyDVarEnv, nameList) of (a, (renamings, _), _) -> (a, renamings) -- | Allocates a new, clean name for the given 'Id' if it doesn't already have @@ -129,8 +129,8 @@ getCleanName x = do checkRefuts :: Id -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached checkRefuts x = do - delta <- ask - case lookupRefuts delta x of + nabla <- ask + case lookupRefuts nabla x of [] -> pure Nothing -- Will just be a wildcard later on _ -> Just <$> getCleanName x @@ -144,8 +144,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc -- The useful information in the latter case is the constructor that we missed, -- not the types of the wildcards in the places that aren't matched as a result. pprPmVar prec x = do - delta <- ask - case lookupSolution delta x of + nabla <- ask + case lookupSolution nabla x of Just (alt, _tvs, args) -> pprPmAltCon prec alt args Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where @@ -160,24 +160,24 @@ pprPmVar prec x = do pprPmAltCon :: PprPrec -> PmAltCon -> [Id] -> PmPprM SDoc pprPmAltCon _prec (PmAltLit l) _ = pure (ppr l) pprPmAltCon prec (PmAltConLike cl) args = do - delta <- ask - pprConLike delta prec cl args + nabla <- ask + pprConLike nabla prec cl args -pprConLike :: Delta -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc -pprConLike delta _prec cl args - | Just pm_expr_list <- pmExprAsList delta (PmAltConLike cl) args +pprConLike :: Nabla -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc +pprConLike nabla _prec cl args + | Just pm_expr_list <- pmExprAsList nabla (PmAltConLike cl) args = case pm_expr_list of NilTerminated list -> brackets . fsep . punctuate comma <$> mapM (pprPmVar appPrec) list WcVarTerminated pref x -> parens . fcat . punctuate colon <$> mapM (pprPmVar appPrec) (toList pref ++ [x]) -pprConLike _delta _prec (RealDataCon con) args +pprConLike _nabla _prec (RealDataCon con) args | isUnboxedTupleCon con , let hash_parens doc = text "(#" <+> doc <+> text "#)" = hash_parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args | isTupleDataCon con = parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args -pprConLike _delta prec cl args +pprConLike _nabla prec cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmVar funPrec x y' <- pprPmVar funPrec y @@ -202,11 +202,11 @@ data PmExprList -- ending in a wildcard variable x (of list type). Should be pretty-printed as -- (1:2:_). -- * @pmExprAsList [] == Just ('NilTerminated' [])@ -pmExprAsList :: Delta -> PmAltCon -> [Id] -> Maybe PmExprList -pmExprAsList delta = go_con [] +pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList +pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution delta x + | Just (alt, _tvs, args) <- lookupSolution nabla x = go_con rev_pref alt args go_var rev_pref x | Just pref <- nonEmpty (reverse rev_pref) ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -15,6 +15,7 @@ Author: George Karachalias module GHC.HsToCore.PmCheck.Types ( -- * Representations for Literals and AltCons PmLit(..), PmLitValue(..), PmAltCon(..), pmLitType, pmAltConType, + isPmAltConMatchStrict, pmAltConImplBangs, -- ** Equality on 'PmAltCon's PmEquality(..), eqPmAltCon, @@ -35,8 +36,8 @@ module GHC.HsToCore.PmCheck.Types ( setIndirectSDIE, setEntrySDIE, traverseSDIE, -- * The pattern match oracle - VarInfo(..), TmState(..), TyState(..), Delta(..), - Deltas(..), initDeltas, liftDeltasM + BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), + Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -226,6 +227,19 @@ pmAltConType :: PmAltCon -> [Type] -> Type pmAltConType (PmAltLit lit) _arg_tys = ASSERT( null _arg_tys ) pmLitType lit pmAltConType (PmAltConLike con) arg_tys = conLikeResTy con arg_tys +-- | Is a match on this constructor forcing the match variable? +-- True of data constructors, literals and pattern synonyms (#17357), but not of +-- newtypes. +-- See Note [Coverage checking Newtype matches] in "GHC.HsToCore.PmCheck.Oracle". +isPmAltConMatchStrict :: PmAltCon -> Bool +isPmAltConMatchStrict PmAltLit{} = True +isPmAltConMatchStrict (PmAltConLike PatSynCon{}) = True -- #17357 +isPmAltConMatchStrict (PmAltConLike (RealDataCon dc)) = not (isNewDataCon dc) + +pmAltConImplBangs :: PmAltCon -> [HsImplBang] +pmAltConImplBangs PmAltLit{} = [] +pmAltConImplBangs (PmAltConLike con) = conLikeImplBangs con + {- Note [Undecidable Equality for PmAltCons] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -477,6 +491,13 @@ instance Outputable a => Outputable (Shared a) where instance Outputable a => Outputable (SharedDIdEnv a) where ppr (SDIE env) = ppr env +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + -- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These -- entries are possibly shared when we figure out that two variables must be -- equal, thus represent the same set of values. @@ -531,6 +552,13 @@ data VarInfo -- because files like Cabal's `LicenseId` define relatively huge enums -- that lead to quadratic or worse behavior. + , vi_bot :: BotInfo + -- ^ Can this variable be ⊥? Models (mutually contradicting) @x ~ ⊥@ and + -- @x ≁ ⊥@ constraints. E.g. + -- * 'MaybeBot': Don't know; Neither @x ~ ⊥@ nor @x ≁ ⊥@. + -- * 'IsBot': @x ~ ⊥@ + -- * 'IsNotBot': @x ≁ ⊥@ + , vi_cache :: !PossibleMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of -- possible constructors of each COMPLETE set. So, if it's not in here, we @@ -538,14 +566,19 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +instance Outputable BotInfo where + ppr MaybeBot = empty + ppr IsBot = text "~⊥" + ppr IsNotBot = text "≁⊥" + -- | Not user-facing. instance Outputable TmState where ppr (TmSt state reps) = ppr state $$ ppr reps -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr cache])) + ppr (VI ty pos neg bot cache) + = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) -- | Initial state of the term oracle. initTmState :: TmState @@ -563,37 +596,38 @@ instance Outputable TyState where initTyState :: TyState initTyState = TySt emptyBag --- | An inert set of canonical (i.e. mutually compatible) term and type --- constraints. -data Delta = MkDelta { delta_ty_st :: TyState -- Type oracle; things like a~Int - , delta_tm_st :: TmState } -- Term oracle; things like x~Nothing +-- | A normalised refinement type ∇ (\"nabla\"), comprised of an inert set of +-- canonical (i.e. mutually compatible) term and type constraints that form the +-- refinement type's predicate. +data Nabla = MkNabla { nabla_ty_st :: TyState -- Type oracle; things like a~Int + , nabla_tm_st :: TmState } -- Term oracle; things like x~Nothing --- | An initial delta that is always satisfiable -initDelta :: Delta -initDelta = MkDelta initTyState initTmState +-- | An initial nabla that is always satisfiable +initNabla :: Nabla +initNabla = MkNabla initTyState initTmState -instance Outputable Delta where - ppr delta = hang (text "Delta") 2 $ vcat [ +instance Outputable Nabla where + ppr nabla = hang (text "Nabla") 2 $ vcat [ -- intentionally formatted this way enable the dev to comment in only -- the info she needs - ppr (delta_tm_st delta), - ppr (delta_ty_st delta) + ppr (nabla_tm_st nabla), + ppr (nabla_ty_st nabla) ] --- | A disjunctive bag of 'Delta's, representing a refinement type. -newtype Deltas = MkDeltas (Bag Delta) +-- | A disjunctive bag of 'Nabla's, representing a refinement type. +newtype Nablas = MkNablas (Bag Nabla) -initDeltas :: Deltas -initDeltas = MkDeltas (unitBag initDelta) +initNablas :: Nablas +initNablas = MkNablas (unitBag initNabla) -instance Outputable Deltas where - ppr (MkDeltas deltas) = ppr deltas +instance Outputable Nablas where + ppr (MkNablas nablas) = ppr nablas -instance Semigroup Deltas where - MkDeltas l <> MkDeltas r = MkDeltas (l `unionBags` r) +instance Semigroup Nablas where + MkNablas l <> MkNablas r = MkNablas (l `unionBags` r) -instance Monoid Deltas where - mempty = MkDeltas emptyBag +instance Monoid Nablas where + mempty = MkNablas emptyBag -liftDeltasM :: Monad m => (Delta -> m (Maybe Delta)) -> Deltas -> m Deltas -liftDeltasM f (MkDeltas ds) = MkDeltas . catBagMaybes <$> (traverse f ds) +liftNablasM :: Monad m => (Nabla -> m (Maybe Nabla)) -> Nablas -> m Nablas +liftNablasM f (MkNablas ds) = MkNablas . catBagMaybes <$> (traverse f ds) ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot ===================================== @@ -2,8 +2,8 @@ module GHC.HsToCore.PmCheck.Types where import GHC.Data.Bag -data Delta +data Nabla -newtype Deltas = MkDeltas (Bag Delta) +newtype Nablas = MkNablas (Bag Nabla) -initDeltas :: Deltas +initNablas :: Nablas ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -106,7 +106,7 @@ import GHC.Tc.Types.Origin import GHC.Types.Annotations import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Deltas) +import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Data.IOEnv import GHC.Types.Name.Reader import GHC.Types.Name @@ -324,9 +324,9 @@ data DsLclEnv = DsLclEnv { dsl_loc :: RealSrcSpan, -- To put in pattern-matching error msgs -- See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck" - -- The set of reaching values Deltas is augmented as we walk inwards, + -- The set of reaching values Nablas is augmented as we walk inwards, -- refined through each pattern match in turn - dsl_deltas :: Deltas + dsl_nablas :: Nablas } -- Inside [| |] brackets, the desugarer looks ===================================== testsuite/tests/pmcheck/should_compile/T10183.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE GADTs, DataKinds, TypeOperators, UnicodeSyntax #-} + +module Foo where + +import GHC.TypeLits + +data List l t where + Nil ∷ List 0 t + (:-) ∷ t → List l t → List (l+1) t + +head' ∷ (1<=l) ⇒ List l t → t +head' (x :- _) = x + +data T a where + TT :: T Bool + TF :: T Int + +f :: T Bool -> Bool +f TT = True + +g :: (a ~ Bool) => T a -> Bool +g TT = True ===================================== testsuite/tests/pmcheck/should_compile/T17340.stderr ===================================== @@ -7,6 +7,10 @@ T17340.hs:19:4: warning: [-Wredundant-bang-patterns] Pattern match has redundant bang In an equation for ‘g’: g x = ... +T17340.hs:23:9: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘h’: h x = ... + T17340.hs:27:4: warning: [-Wredundant-bang-patterns] Pattern match has redundant bang In an equation for ‘k’: k _ = ... ===================================== testsuite/tests/pmcheck/should_compile/T17378.hs ===================================== @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE EmptyCase #-} +module Lib where + +import Data.Type.Equality +import Data.Functor.Identity +import Data.Void + +f :: a :~: Int -> a :~: Bool -> () +f !_ x = case x of {} + +g :: Identity (a :~: Int) -> a :~: Bool -> () +g (Identity _) Refl = () + +data SMaybe a = SNothing + | SJust !a + +-- | Exhaustive. Note how in addition to @{(a,b) | b /~ True}@, the value set +-- @{(a,b) | y /~ SNothing, b ~ True}@ flows into the next equation, but @y@ is +-- no longer in scope. Normally, we have no way of matching on that without a +-- wildcard match, but in this case we refute @y ~ SJust z@ by unleashing type +-- evidence saying that @z@ must be 'Void' by matching on 'Refl'. +h :: forall a. a :~: Void -> Bool -> () +h _ True | let y = undefined :: SMaybe a, SNothing <- y = () +h Refl False = () ===================================== testsuite/tests/pmcheck/should_compile/T17725.hs ===================================== @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +module Lib where + +newtype IInt = IInt Int + +f :: IInt -> Bool -> () +f !(IInt _) True = () +f (IInt 42) True = () +f _ _ = () ===================================== testsuite/tests/pmcheck/should_compile/T17725.stderr ===================================== @@ -0,0 +1,4 @@ + +T17725.hs:9:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f (IInt 42) True = ... ===================================== testsuite/tests/pmcheck/should_compile/T17729.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -fforce-recomp -Wincomplete-patterns #-} + +incomplete :: Maybe a -> Bool +incomplete ma = case (ma, ()) of + (Nothing, _) -> False + +{-# COMPLETE Pat #-} +pattern Pat :: a -> b -> (a, b) +pattern Pat a b = (a, b) + +main :: IO () +main = print $ incomplete (Just ()) ===================================== testsuite/tests/pmcheck/should_compile/T17729.stderr ===================================== @@ -0,0 +1,4 @@ + +T17729.hs:5:17: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: Patterns not matched: ((Just _), ()) ===================================== testsuite/tests/pmcheck/should_compile/T18273.hs ===================================== @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -fforce-recomp -Wincomplete-patterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} + +module Bug where + +import Data.Kind +import Data.Void + +type SFalse = SBool 'False +type STrue = SBool 'True + +data SBool :: Bool -> Type where + SFalse :: SFalse + STrue :: STrue + +type family F (b :: Bool) :: Type where + F 'False = Void + F 'True = () + +data T (b :: Bool) + = MkT1 + | MkT2 !(F b) + +ex :: SBool b -> T b -> () +ex sb t = + case t of + MkT1 -> () + MkT2 f -> + case sb of + STrue -> f + +ex2 :: SBool b -> T b -> () +ex2 sb t = + case t of + MkT2 f -> + case sb of + STrue -> f + MkT1 -> () ===================================== testsuite/tests/pmcheck/should_compile/T18341.hs ===================================== @@ -0,0 +1,24 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} + +module Lib where + +import GHC.Exts + +data T = MkT !Int {-# UNPACK #-} !Int Int# + +f :: T -> () +f (MkT _ _ _) | False = () -- inaccessible +f (MkT !_ _ _) | False = () -- redundant, not only inaccessible! +f _ = () + +g :: T -> () +g (MkT _ _ _) | False = () -- inaccessible +g (MkT _ !_ _) | False = () -- redundant, not only inaccessible! +g _ = () + +h :: T -> () +h (MkT _ _ _) | False = () -- inaccessible +h (MkT _ _ !_) | False = () -- redundant, not only inaccessible! +h _ = () ===================================== testsuite/tests/pmcheck/should_compile/T18341.stderr ===================================== @@ -0,0 +1,24 @@ + +T18341.hs:12:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f (MkT _ _ _) | False = ... + +T18341.hs:13:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f (MkT !_ _ _) | False = ... + +T18341.hs:17:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘g’: g (MkT _ _ _) | False = ... + +T18341.hs:18:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘g’: g (MkT _ !_ _) | False = ... + +T18341.hs:22:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘h’: h (MkT _ _ _) | False = ... + +T18341.hs:23:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (MkT _ _ !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -36,6 +36,8 @@ test('T9951b', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T9951', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T10183', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11303', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) test('T11276', collect_compiler_stats('bytes allocated',10), compile, @@ -108,12 +110,18 @@ test('T17357', expect_broken(17357), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17376', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17378', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17465', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17646', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17703', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17725', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17729', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17783', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17977', collect_compiler_stats('bytes allocated',10), compile, @@ -122,6 +130,10 @@ test('T17977b', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18049', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18273', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18341', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18478', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18533', normal, compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/beffbc38e6b4d37d98a01b11472b2d34fc3cc78c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/beffbc38e6b4d37d98a01b11472b2d34fc3cc78c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 08:31:55 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Sep 2020 04:31:55 -0400 Subject: [Git][ghc/ghc][wip/ftext-no-length] 917 commits: Fix ApplicativeDo regression #17835 Message-ID: <5f4e06fb96496_80b88dabf0101066de@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/ftext-no-length at Glasgow Haskell Compiler / GHC Commits: 19f12557 by Josef Svenningsson at 2020-03-23T14:05:33-04:00 Fix ApplicativeDo regression #17835 A previous fix for #15344 made sure that monadic 'fail' is used properly when translating ApplicativeDo. However, it didn't properly account for when a 'fail' will be inserted which resulted in some programs failing with a type error. - - - - - 2643ba46 by Paavo at 2020-03-24T08:31:32-04:00 Add example and doc for Arg (Fixes #17153) - - - - - 703221f4 by Roland Senn at 2020-03-25T14:45:04-04:00 Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) - Provide the export list of the `Main` module as parameter to the `compiler/typecheck/TcRnDriver.hs:check_main` function. - Instead of `lookupOccRn_maybe` call the function `lookupInfoOccRn`. It returns the list `mains_all` of all the main functions in scope. - Select from this list `mains_all` all `main` functions that are in the export list of the `Main` module. - If this new list contains exactly one single `main` function, then typechecking continues. - Otherwise issue an appropriate error message. - - - - - 3e27205a by Sebastian Graf at 2020-03-25T14:45:40-04:00 Remove -fkill-absence and -fkill-one-shot flags They seem to be a benchmarking vestige of the Cardinality paper and probably shouldn't have been merged to HEAD in the first place. - - - - - 262e42aa by Peter Trommler at 2020-03-25T22:41:39-04:00 Do not panic on linker errors - - - - - 0de03cd7 by Sylvain Henry at 2020-03-25T22:42:02-04:00 DynFlags refactoring III Use Platform instead of DynFlags when possible: * `tARGET_MIN_INT` et al. replaced with `platformMinInt` et al. * no more DynFlags in PreRules: added a new `RuleOpts` datatype * don't use `wORD_SIZE` in the compiler * make `wordAlignment` use `Platform` * make `dOUBLE_SIZE` a constant Metric Decrease: T13035 T1969 - - - - - 7a04920b by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: fix a typo in liftA doc This change removes an extra '|' that should not be rendered in the liftA documentation. Tracking: #17929 - - - - - 1c5a15f7 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add Control.Applicative optional example This change adds an optional example. Tracking: #17929 - - - - - 6d172e63 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add markup around Except - - - - - eb2162c8 by John Ericson at 2020-03-26T12:37:08-04:00 Remove unused `ghciTablesNextToCode` from compiler proper - - - - - f51efc4b by Joachim Breitner at 2020-03-26T12:37:09-04:00 Prepare to use run-time tablesNextToCode in compiler exclusively Factor out CPP as much as possible to prepare for runtime determinattion. Progress towards #15548 - - - - - 1c446220 by Joachim Breitner at 2020-03-26T12:37:09-04:00 Use run-time tablesNextToCode in compiler exclusively (#15548) Summary: - There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely. The field within `PlatformMisc` within `DynFlags` is used instead. - The field is still not exposed as a CLI flag. We might consider some way to ensure the right RTS / libraries are used before doing that. Original reviewers: Original subscribers: TerrorJack, rwbarton, carter Original Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 1941ef4f by Sylvain Henry at 2020-03-29T17:28:51-04:00 Modules: Types (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - 1c7c6f1a by Sylvain Henry at 2020-03-29T17:28:51-04:00 Remove GHC.Types.Unique.Map module This module isn't used anywhere in GHC. - - - - - f1a6c73d by Sylvain Henry at 2020-03-29T17:28:51-04:00 Merge GHC.Types.CostCentre.Init into GHC.Driver.CodeOutput - - - - - 54250f2d by Simon Peyton Jones at 2020-03-29T17:29:30-04:00 Demand analysis: simplify the demand for a RHS Ticket #17932 showed that we were using a stupid demand for the RHS of a let-binding, when the result is a product. This was the result of a "fix" in 2013, which (happily) turns out to no longer be necessary. So I just deleted the code, which simplifies the demand analyser, and fixes #17932. That in turn uncovered that the anticipation of worker/wrapper in CPR analysis was inaccurate, hence the logic that decides whether to unbox an argument in WW was extracted into a function `wantToUnbox`, now consulted by CPR analysis. I tried nofib, and got 0.0% perf changes. All this came up when messing about with !2873 (ticket #17917), but is idependent of it. Unfortunately, this patch regresses #4267 and realised that it is now blocked on #16335. - - - - - 03060b2f by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 on Windows Fixes line ending normalization issue. - - - - - 1f7995ba by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 Fix missing quoting and expected exit code. - - - - - ef9c608e by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - e54500c1 by Sylvain Henry at 2020-03-29T17:30:47-04:00 Store ComponentId details As far as GHC is concerned, installed package components ("units") are identified by an opaque ComponentId string provided by Cabal. But we don't want to display it to users (as it contains a hash) so GHC queries the database to retrieve some infos about the original source package (name, version, component name). This patch caches these infos in the ComponentId itself so that we don't need to provide DynFlags (which contains installed package informations) to print a ComponentId. In the future we want GHC to support several independent package states (e.g. for plugins and for target code), hence we need to avoid implicitly querying a single global package state. - - - - - 7e7cb714 by Marius Bakke at 2020-03-29T17:31:27-04:00 testsuite: Remove test that dlopens a PIE object. glibc 2.30 disallowed dlopening PIE objects, so just remove the test. Fixes #17952. - - - - - 6c8f80d8 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Correct haddocks for testBit in Data.Bits It conflated the nth bit with the bit at offset n. Now we instead give the definition in terms of `bit and `.&.` on top of clearer phrasing. - - - - - c916f190 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Apply suggestion to libraries/base/Data/Bits.hs - - - - - 64bf7f51 by Ben Gamari at 2020-03-29T17:32:41-04:00 gitlab-ci: Add FreeBSD release job - - - - - a0d8e92e by Ryan Scott at 2020-03-29T17:33:20-04:00 Run checkNewDataCon before constraint-solving newtype constructors Within `checkValidDataCon`, we used to run `checkValidType` on the argument types of a newtype constructor before running `checkNewDataCon`, which ensures that the user does not attempt non-sensical things such as newtypes with multiple arguments or constraints. This works out in most situations, but this falls over on a corner case revealed in #17955: ```hs newtype T = Coercible () T => T () ``` `checkValidType`, among other things, peforms an ambiguity check on the context of a data constructor, and that it turn invokes the constraint solver. It turns out that there is a special case in the constraint solver for representational equalities (read: `Coercible` constraints) that causes newtypes to be unwrapped (see `Note [Unwrap newtypes first]` in `TcCanonical`). This special case does not know how to cope with an ill formed newtype like `T`, so it ends up panicking. The solution is surprisingly simple: just invoke `checkNewDataCon` before `checkValidType` to ensure that the illicit newtype constructor context is detected before the constraint solver can run amok with it. Fixes #17955. - - - - - 45eb9d8c by Krzysztof Gogolewski at 2020-03-29T17:33:59-04:00 Minor cleanup - Simplify mkBuildExpr, the function newTyVars was called only on a one-element list. - TTG: use noExtCon in more places. This is more future-proof. - In zonkExpr, panic instead of printing a warning. - - - - - f024b6e3 by Sylvain Henry at 2020-03-30T12:48:39+02:00 Expect T4267 to pass Since 54250f2d8de910b094070c1b48f086030df634b1 we expected T4267 to fail, but it passes on CI. - - - - - 57b888c0 by Ryan Scott at 2020-03-31T10:54:20-04:00 Require GHC 8.8 as the minimum compiler for bootstrapping This allows us to remove several bits of CPP that are either always true or no longer reachable. As an added bonus, we no longer need to worry about importing `Control.Monad.Fail.fail` qualified to avoid clashing with `Control.Monad.fail`, since the latter is now the same as the former. - - - - - 33f09551 by Ryan Scott at 2020-03-31T10:54:57-04:00 Add regression test for #17963 The panic in #17963 happened to be fixed by commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70. This patch adds a regression test to ensure that it remains fixed. Fixes #17963. - - - - - 09a36e80 by Ömer Sinan Ağacan at 2020-03-31T10:55:37-04:00 Simplify stderrSupportsAnsiColors The combinator andM is used only once, and the code is shorter and simpler if you inline it. - - - - - 95bccdd0 by Ben Gamari at 2020-03-31T10:56:19-04:00 base: Ensure that encoding global variables aren't inlined As noted in #17970, these (e.g. `getFileSystemEncoding` and `setFileSystemEncoding`) previously had unfoldings, which would break their global-ness. While not strictly necessary, I also add a NOINLINE on `initLocaleEncoding` since it is used in `System.IO`, ensuring that we only system's query the locale encoding once. Fixes #17970. - - - - - 982aaa83 by Andreas Klebinger at 2020-03-31T10:56:55-04:00 Update hadrian index revision. Required in order to build hadrian using ghc-8.10 - - - - - 4b9c5864 by Ben Gamari at 2020-03-31T10:57:32-04:00 integer-gmp: Bump version and add changelog entry - - - - - 9b39f2e6 by Ryan Scott at 2020-04-01T01:20:00-04:00 Clean up "Eta reduction for data families" Notes Before, there were two distinct Notes named "Eta reduction for data families". This renames one of them to "Implementing eta reduction for data families" to disambiguate the two and fixes references in other parts of the codebase to ensure that they are pointing to the right place. Fixes #17313. [ci skip] - - - - - 7627eab5 by Ryan Scott at 2020-04-01T01:20:38-04:00 Fix the changelog/@since information for hGetContents'/getContents'/readFile' Fixes #17979. [ci skip] - - - - - 0002db1b by Sylvain Henry at 2020-04-01T01:21:27-04:00 Kill wORDS_BIGENDIAN and replace it with platformByteOrder (#17957) Metric Decrease: T13035 T1969 - - - - - 7b217179 by Sebastian Graf at 2020-04-01T15:03:24-04:00 PmCheck: Adjust recursion depth for inhabitation test In #17977, we ran into the reduction depth limit of the typechecker. That was only a symptom of a much broader issue: The recursion depth of the coverage checker for trying to instantiate strict fields in the `nonVoid` test was far too high (100, the `defaultMaxTcBound`). As a result, we were performing quite poorly on `T17977`. Short of a proper termination analysis to prove emptyness of a type, we just arbitrarily default to a much lower recursion limit of 3. Fixes #17977. - - - - - 3c09f636 by Andreas Klebinger at 2020-04-01T15:03:59-04:00 Make hadrian pass on the no-colour setting to GHC. Fixes #17983. - - - - - b943b25d by Simon Peyton Jones at 2020-04-02T01:45:58-04:00 Re-engineer the binder-swap transformation The binder-swap transformation is implemented by the occurrence analyser -- see Note [Binder swap] in OccurAnal. However it had a very nasty corner in it, for the case where the case scrutinee was a GlobalId. This led to trouble and hacks, and ultimately to #16296. This patch re-engineers how the occurrence analyser implements the binder-swap, by actually carrying out a substitution rather than by adding a let-binding. It's all described in Note [The binder-swap substitution]. I did a few other things along the way * Fix a bug in StgCse, which could allow a loop breaker to be CSE'd away. See Note [Care with loop breakers] in StgCse. I think it can only show up if occurrence analyser sets up bad loop breakers, but still. * Better commenting in SimplUtils.prepareAlts * A little refactoring in CoreUnfold; nothing significant e.g. rename CoreUnfold.mkTopUnfolding to mkFinalUnfolding * Renamed CoreSyn.isFragileUnfolding to hasCoreUnfolding * Move mkRuleInfo to CoreFVs We observed respectively 4.6% and 5.9% allocation decreases for the following tests: Metric Decrease: T9961 haddock.base - - - - - 42d68364 by Sebastian Graf at 2020-04-02T01:46:34-04:00 Preserve precise exceptions in strictness analysis Fix #13380 and #17676 by 1. Changing `raiseIO#` to have `topDiv` instead of `botDiv` 2. Give it special treatment in `Simplifier.Util.mkArgInfo`, treating it as if it still had `botDiv`, to recover dead code elimination. This is the first commit of the plan outlined in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2525#note_260886. - - - - - 0a88dd11 by Ömer Sinan Ağacan at 2020-04-02T01:47:25-04:00 Fix a pointer format string in RTS - - - - - 5beac042 by Ömer Sinan Ağacan at 2020-04-02T01:48:05-04:00 Remove unused closure stg_IND_direct - - - - - 88f38b03 by Ben Gamari at 2020-04-02T01:48:42-04:00 Session: Memoize stderrSupportsAnsiColors Not only is this a reasonable efficiency measure but it avoids making reentrant calls into ncurses, which is not thread-safe. See #17922. - - - - - 27740f24 by Ryan Scott at 2020-04-02T01:49:21-04:00 Make Hadrian build with Cabal-3.2 GHC 8.10 ships with `Cabal-3.2.0.0`, so it would be convenient to make Hadrian supporting building against 3.2.* instead of having to rebuild the entirety of `Cabal-3.0.0.0`. There is one API change in `Cabal-3.2.*` that affects Hadrian: the `synopsis` and `description` functions now return `ShortText` instead of `String`. Since Hadrian manipulates these `String`s in various places, I found that the simplest fix was to use CPP to convert `ShortText` to `String`s where appropriate. - - - - - 49802002 by Sylvain Henry at 2020-04-02T01:50:00-04:00 Update Stack resolver for hadrian/build-stack Broken by 57b888c0e90be7189285a6b078c30b26d0923809 - - - - - 30a63e79 by Ryan Scott at 2020-04-02T01:50:36-04:00 Fix two ASSERT buglets in reifyDataCon Two `ASSERT`s in `reifyDataCon` were always using `arg_tys`, but `arg_tys` is not meaningful for GADT constructors. In fact, it's worse than non-meaningful, since using `arg_tys` when reifying a GADT constructor can lead to failed `ASSERT`ions, as #17305 demonstrates. This patch applies the simplest possible fix to the immediate problem. The `ASSERT`s now use `r_arg_tys` instead of `arg_tys`, as the former makes sure to give something meaningful for GADT constructors. This makes the panic go away at the very least. There is still an underlying issue with the way the internals of `reifyDataCon` work, as described in https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227023, but we leave that as future work, since fixing the underlying issue is much trickier (see https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227087). - - - - - ef7576c4 by Zubin Duggal at 2020-04-03T06:24:56-04:00 Add outputable instances for the types in GHC.Iface.Ext.Types, add -ddump-hie flag to dump pretty printed contents of the .hie file Metric Increase: hie002 Because of the regression on i386: compile_time/bytes allocated increased from i386-linux-deb9 baseline @ HEAD~10: Expected hie002 (normal) compile_time/bytes allocated: 583014888.0 +/-10% Lower bound hie002 (normal) compile_time/bytes allocated: 524713399 Upper bound hie002 (normal) compile_time/bytes allocated: 641316377 Actual hie002 (normal) compile_time/bytes allocated: 877986292 Deviation hie002 (normal) compile_time/bytes allocated: 50.6 % *** unexpected stat test failure for hie002(normal) - - - - - 9462452a by Andreas Klebinger at 2020-04-03T06:25:33-04:00 Improve and refactor StgToCmm codegen for DataCons. We now differentiate three cases of constructor bindings: 1)Bindings which we can "replace" with a reference to an existing closure. Reference the replacement closure when accessing the binding. 2)Bindings which we can "replace" as above. But we still generate a closure which will be referenced by modules importing this binding. 3)For any other binding generate a closure. Then reference it. Before this patch 1) did only apply to local bindings and we didn't do 2) at all. - - - - - a214d214 by Moritz Bruder at 2020-04-03T06:26:11-04:00 Add singleton to NonEmpty in libraries/base This adds a definition to construct a singleton non-empty list (Data.List.NonEmpty) according to issue #17851. - - - - - f7597aa0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Testsuite: measure compiler stats for T16190 We were mistakenly measuring program stats - - - - - a485c3c4 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Move blob handling into StgToCmm Move handling of big literal strings from CmmToAsm to StgToCmm. It avoids the use of `sdocWithDynFlags` (cf #10143). We might need to move this handling even higher in the pipeline in the future (cf #17960): this patch will make it easier. - - - - - cc2918a0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Refactor CmmStatics In !2959 we noticed that there was some redundant code (in GHC.Cmm.Utils and GHC.Cmm.StgToCmm.Utils) used to deal with `CmmStatics` datatype (before SRT generation) and `RawCmmStatics` datatype (after SRT generation). This patch removes this redundant code by using a single GADT for (Raw)CmmStatics. - - - - - 9e60273d by Maxim Koltsov at 2020-04-03T06:27:32-04:00 Fix haddock formatting in Control.Monad.ST.Lazy.Imp.hs - - - - - 1b7e8a94 by Andreas Klebinger at 2020-04-03T06:28:08-04:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 4291bdda by Simon Peyton Jones at 2020-04-03T06:28:44-04:00 Major improvements to the specialiser This patch is joint work of Alexis King and Simon PJ. It does some significant refactoring of the type-class specialiser. Main highlights: * We can specialise functions with types like f :: Eq a => a -> Ord b => b => blah where the classes aren't all at the front (#16473). Here we can correctly specialise 'f' based on a call like f @Int @Bool dEqInt x dOrdBool This change really happened in an earlier patch commit 2d0cf6252957b8980d89481ecd0b79891da4b14b Author: Sandy Maguire <sandy at sandymaguire.me> Date: Thu May 16 12:12:10 2019 -0400 work that this new patch builds directly on that work, and refactors it a bit. * We can specialise functions with implicit parameters (#17930) g :: (?foo :: Bool, Show a) => a -> String Previously we could not, but now they behave just like a non-class argument as in 'f' above. * We can specialise under-saturated calls, where some (but not all of the dictionary arguments are provided (#17966). For example, we can specialise the above 'f' based on a call map (f @Int dEqInt) xs even though we don't (and can't) give Ord dictionary. This may sound exotic, but #17966 is a program from the wild, and showed significant perf loss for functions like f, if you need saturation of all dictionaries. * We fix a buglet in which a floated dictionary had a bogus demand (#17810), by using zapIdDemandInfo in the NonRec case of specBind. * A tiny side benefit: we can drop dead arguments to specialised functions; see Note [Drop dead args from specialisations] * Fixed a bug in deciding what dictionaries are "interesting"; see Note [Keep the old dictionaries interesting] This is all achieved by by building on Sandy Macguire's work in defining SpecArg, which mkCallUDs uses to describe the arguments of the call. Main changes: * Main work is in specHeader, which marched down the [InBndr] from the function definition and the [SpecArg] from the call site, together. * specCalls no longer has an arity check; the entire mechanism now handles unders-saturated calls fine. * mkCallUDs decides on an argument-by-argument basis whether to specialise a particular dictionary argument; this is new. See mk_spec_arg in mkCallUDs. It looks as if there are many more lines of code, but I think that all the extra lines are comments! - - - - - 40a85563 by Ömer Sinan Ağacan at 2020-04-03T18:26:19+03:00 Revert accidental change in 9462452 [ci skip] - - - - - bd75e5da by Ryan Scott at 2020-04-04T07:07:58-04:00 Enable ImpredicativeTypes internally when typechecking selector bindings This is necessary for certain record selectors with higher-rank types, such as the examples in #18005. See `Note [Impredicative record selectors]` in `TcTyDecls`. Fixes #18005. - - - - - dcfe29c8 by Ömer Sinan Ağacan at 2020-04-06T13:16:08-04:00 Don't override proc CafInfos in ticky builds Fixes #17947 When we have a ticky label for a proc, IdLabels for the ticky counter and proc entry share the same Name. This caused overriding proc CafInfos with the ticky CafInfos (i.e. NoCafRefs) during SRT analysis. We now ignore the ticky labels when building SRTMaps. This makes sense because: - When building the current module they don't need to be in SRTMaps as they're initialized as non-CAFFY (see mkRednCountsLabel), so they don't take part in the dependency analysis and they're never added to SRTs. (Reminder: a "dependency" in the SRT analysis is a CAFFY dependency, non-CAFFY uses are not considered as dependencies for the algorithm) - They don't appear in the interfaces as they're not exported, so it doesn't matter for cross-module concerns whether they're in the SRTMap or not. See also the new Note [Ticky labels in SRT analysis]. - - - - - cec2c71f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Fix an tricky specialiser loop Issue #17151 was a very tricky example of a bug in which the specialiser accidentally constructs a recurive dictionary, so that everything turns into bottom. I have fixed variants of this bug at least twice before: see Note [Avoiding loops]. It was a bit of a struggle to isolate the problem, greatly aided by the work that Alexey Kuleshevich did in distilling a test case. Once I'd understood the problem, it was not difficult to fix, though it did lead me a bit of refactoring in specImports. - - - - - e850d14f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Refactoring only This refactors DictBinds into a data type rather than a pair. No change in behaviour, just better code - - - - - f38e8d61 by Daniel Gröber at 2020-04-07T02:00:05-04:00 rts: ProfHeap: Fix memory leak when not compiled with profiling If we're doing heap profiling on an unprofiled executable we keep allocating new space in initEra via nextEra on each profiler run but we don't have a corresponding freeEra call. We do free the last era in endHeapProfiling but previous eras will have been overwritten by initEra and will never get free()ed. Metric Decrease: space_leak_001 - - - - - bcd66859 by Sebastian Graf at 2020-04-07T02:00:41-04:00 Re-export GHC.Magic.noinline from base - - - - - 3d2991f8 by Ben Gamari at 2020-04-07T18:36:09-04:00 simplifier: Kill off ufKeenessFactor We used to have another factor, ufKeenessFactor, which would scale the discounts before they were subtracted from the size. This was justified with the following comment: -- We multiple the raw discounts (args_discount and result_discount) -- ty opt_UnfoldingKeenessFactor because the former have to do with -- *size* whereas the discounts imply that there's some extra -- *efficiency* to be gained (e.g. beta reductions, case reductions) -- by inlining. However, this is highly suspect since it means that we subtract a *scaled* size from an absolute size, resulting in crazy (e.g. negative) scores in some cases (#15304). We consequently killed off ufKeenessFactor and bumped up the ufUseThreshold to compensate. Adjustment of unfolding use threshold ===================================== Since this removes a discount from our inlining heuristic, I revisited our default choice of -funfolding-use-threshold to minimize the change in overall inlining behavior. Specifically, I measured runtime allocations and executable size of nofib and the testsuite performance tests built using compilers (and core libraries) built with several values of -funfolding-use-threshold. This comes as a result of a quantitative comparison of testsuite performance and code size as a function of ufUseThreshold, comparing GHC trees using values of 50, 60, 70, 80, 90, and 100. The test set consisted of nofib and the testsuite performance tests. A full summary of these measurements are found in the description of !2608 Comparing executable sizes (relative to the base commit) across all nofib tests, we see that sizes are similar to the baseline: gmean min max median thresh 50 -6.36% -7.04% -4.82% -6.46% 60 -5.04% -5.97% -3.83% -5.11% 70 -2.90% -3.84% -2.31% -2.92% 80 -0.75% -2.16% -0.42% -0.73% 90 +0.24% -0.41% +0.55% +0.26% 100 +1.36% +0.80% +1.64% +1.37% baseline +0.00% +0.00% +0.00% +0.00% Likewise, looking at runtime allocations we see that 80 gives slightly better optimisation than the baseline: gmean min max median thresh 50 +0.16% -0.16% +4.43% +0.00% 60 +0.09% -0.00% +3.10% +0.00% 70 +0.04% -0.09% +2.29% +0.00% 80 +0.02% -1.17% +2.29% +0.00% 90 -0.02% -2.59% +1.86% +0.00% 100 +0.00% -2.59% +7.51% -0.00% baseline +0.00% +0.00% +0.00% +0.00% Finally, I had to add a NOINLINE in T4306 to ensure that `upd` is worker-wrappered as the test expects. This makes me wonder whether the inlining heuristic is now too liberal as `upd` is quite a large function. The same measure was taken in T12600. Wall clock time compiling Cabal with -O0 thresh 50 60 70 80 90 100 baseline build-Cabal 93.88 89.58 92.59 90.09 100.26 94.81 89.13 Also, this change happens to avoid the spurious test output in `plugin-recomp-change` and `plugin-recomp-change-prof` (see #17308). Metric Decrease: hie002 T12234 T13035 T13719 T14683 T4801 T5631 T5642 T9020 T9872d T9961 Metric Increase: T12150 T12425 T13701 T14697 T15426 T1969 T3064 T5837 T6048 T9203 T9872a T9872b T9872c T9872d haddock.Cabal haddock.base haddock.compiler - - - - - 255418da by Sylvain Henry at 2020-04-07T18:36:49-04:00 Modules: type-checker (#13009) Update Haddock submodule - - - - - 04b6cf94 by Ryan Scott at 2020-04-07T19:43:20-04:00 Make NoExtCon fields strict This changes every unused TTG extension constructor to be strict in its field so that the pattern-match coverage checker is smart enough any such constructors are unreachable in pattern matches. This lets us remove nearly every use of `noExtCon` in the GHC API. The only ones we cannot remove are ones underneath uses of `ghcPass`, but that is only because GHC 8.8's and 8.10's coverage checkers weren't smart enough to perform this kind of reasoning. GHC HEAD's coverage checker, on the other hand, _is_ smart enough, so we guard these uses of `noExtCon` with CPP for now. Bumps the `haddock` submodule. Fixes #17992. - - - - - 7802fa17 by Ryan Scott at 2020-04-08T16:43:44-04:00 Handle promoted data constructors in typeToLHsType correctly Instead of using `nlHsTyVar`, which hardcodes `NotPromoted`, have `typeToLHsType` pick between `Promoted` and `NotPromoted` by checking if a type constructor is promoted using `isPromotedDataCon`. Fixes #18020. - - - - - ce481361 by Ben Gamari at 2020-04-09T16:17:21-04:00 hadrian: Use --export-dynamic when linking iserv As noticed in #17962, the make build system currently does this (see 3ce0e0ba) but the change was never ported to Hadrian. - - - - - fa66f143 by Ben Gamari at 2020-04-09T16:17:21-04:00 iserv: Don't pass --export-dynamic on FreeBSD This is definitely a hack but it's probably the best we can do for now. Hadrian does the right thing here by passing --export-dynamic only to the linker. - - - - - 39075176 by Ömer Sinan Ağacan at 2020-04-09T16:18:00-04:00 Fix CNF handling in compacting GC Fixes #17937 Previously compacting GC simply ignored CNFs. This is mostly fine as most (see "What about small compacts?" below) CNF objects don't have outgoing pointers, and are "large" (allocated in large blocks) and large objects are not moved or compacted. However if we do GC *during* sharing-preserving compaction then the CNF will have a hash table mapping objects that have been moved to the CNF to their location in the CNF, to be able to preserve sharing. This case is handled in the copying collector, in `scavenge_compact`, where we evacuate hash table entries and then rehash the table. Compacting GC ignored this case. We now visit CNFs in all generations when threading pointers to the compacted heap and thread hash table keys. A visited CNF is added to the list `nfdata_chain`. After compaction is done, we re-visit the CNFs in that list and rehash the tables. The overhead is minimal: the list is static in `Compact.c`, and link field is added to `StgCompactNFData` closure. Programs that don't use CNFs should not be affected. To test this CNF tests are now also run in a new way 'compacting_gc', which just passes `-c` to the RTS, enabling compacting GC for the oldest generation. Before this patch the result would be: Unexpected failures: compact_gc.run compact_gc [bad exit code (139)] (compacting_gc) compact_huge_array.run compact_huge_array [bad exit code (1)] (compacting_gc) With this patch all tests pass. I can also pass `-c -DS` without any failures. What about small compacts? Small CNFs are still not handled by the compacting GC. However so far I'm unable to write a test that triggers a runtime panic ("update_fwd: unknown/strange object") by allocating a small CNF in a compated heap. It's possible that I'm missing something and it's not possible to have a small CNF. NoFib Results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS +0.1% 0.0% 0.0% +0.0% +0.0% CSD +0.1% 0.0% 0.0% 0.0% 0.0% FS +0.1% 0.0% 0.0% 0.0% 0.0% S +0.1% 0.0% 0.0% 0.0% 0.0% VS +0.1% 0.0% 0.0% 0.0% 0.0% VSD +0.1% 0.0% +0.0% +0.0% -0.0% VSM +0.1% 0.0% +0.0% -0.0% 0.0% anna +0.0% 0.0% -0.0% -0.0% -0.0% ansi +0.1% 0.0% +0.0% +0.0% +0.0% atom +0.1% 0.0% +0.0% +0.0% +0.0% awards +0.1% 0.0% +0.0% +0.0% +0.0% banner +0.1% 0.0% +0.0% +0.0% +0.0% bernouilli +0.1% 0.0% 0.0% -0.0% +0.0% binary-trees +0.1% 0.0% -0.0% -0.0% 0.0% boyer +0.1% 0.0% +0.0% +0.0% +0.0% boyer2 +0.1% 0.0% +0.0% +0.0% +0.0% bspt +0.1% 0.0% -0.0% -0.0% -0.0% cacheprof +0.1% 0.0% -0.0% -0.0% -0.0% calendar +0.1% 0.0% +0.0% +0.0% +0.0% cichelli +0.1% 0.0% +0.0% +0.0% +0.0% circsim +0.1% 0.0% +0.0% +0.0% +0.0% clausify +0.1% 0.0% -0.0% +0.0% +0.0% comp_lab_zift +0.1% 0.0% +0.0% +0.0% +0.0% compress +0.1% 0.0% +0.0% +0.0% 0.0% compress2 +0.1% 0.0% -0.0% 0.0% 0.0% constraints +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm1 +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm2 +0.1% 0.0% +0.0% +0.0% +0.0% cse +0.1% 0.0% +0.0% +0.0% +0.0% digits-of-e1 +0.1% 0.0% +0.0% -0.0% -0.0% digits-of-e2 +0.1% 0.0% -0.0% -0.0% -0.0% dom-lt +0.1% 0.0% +0.0% +0.0% +0.0% eliza +0.1% 0.0% +0.0% +0.0% +0.0% event +0.1% 0.0% +0.0% +0.0% +0.0% exact-reals +0.1% 0.0% +0.0% +0.0% +0.0% exp3_8 +0.1% 0.0% +0.0% -0.0% 0.0% expert +0.1% 0.0% +0.0% +0.0% +0.0% fannkuch-redux +0.1% 0.0% -0.0% 0.0% 0.0% fasta +0.1% 0.0% -0.0% +0.0% +0.0% fem +0.1% 0.0% -0.0% +0.0% 0.0% fft +0.1% 0.0% -0.0% +0.0% +0.0% fft2 +0.1% 0.0% +0.0% +0.0% +0.0% fibheaps +0.1% 0.0% +0.0% +0.0% +0.0% fish +0.1% 0.0% +0.0% +0.0% +0.0% fluid +0.0% 0.0% +0.0% +0.0% +0.0% fulsom +0.1% 0.0% -0.0% +0.0% 0.0% gamteb +0.1% 0.0% +0.0% +0.0% 0.0% gcd +0.1% 0.0% +0.0% +0.0% +0.0% gen_regexps +0.1% 0.0% -0.0% +0.0% 0.0% genfft +0.1% 0.0% +0.0% +0.0% +0.0% gg +0.1% 0.0% 0.0% +0.0% +0.0% grep +0.1% 0.0% -0.0% +0.0% +0.0% hidden +0.1% 0.0% +0.0% -0.0% 0.0% hpg +0.1% 0.0% -0.0% -0.0% -0.0% ida +0.1% 0.0% +0.0% +0.0% +0.0% infer +0.1% 0.0% +0.0% 0.0% -0.0% integer +0.1% 0.0% +0.0% +0.0% +0.0% integrate +0.1% 0.0% -0.0% -0.0% -0.0% k-nucleotide +0.1% 0.0% +0.0% +0.0% 0.0% kahan +0.1% 0.0% +0.0% +0.0% +0.0% knights +0.1% 0.0% -0.0% -0.0% -0.0% lambda +0.1% 0.0% +0.0% +0.0% -0.0% last-piece +0.1% 0.0% +0.0% 0.0% 0.0% lcss +0.1% 0.0% +0.0% +0.0% 0.0% life +0.1% 0.0% -0.0% +0.0% +0.0% lift +0.1% 0.0% +0.0% +0.0% +0.0% linear +0.1% 0.0% -0.0% +0.0% 0.0% listcompr +0.1% 0.0% +0.0% +0.0% +0.0% listcopy +0.1% 0.0% +0.0% +0.0% +0.0% maillist +0.1% 0.0% +0.0% -0.0% -0.0% mandel +0.1% 0.0% +0.0% +0.0% 0.0% mandel2 +0.1% 0.0% +0.0% +0.0% +0.0% mate +0.1% 0.0% +0.0% 0.0% +0.0% minimax +0.1% 0.0% -0.0% 0.0% -0.0% mkhprog +0.1% 0.0% +0.0% +0.0% +0.0% multiplier +0.1% 0.0% +0.0% 0.0% 0.0% n-body +0.1% 0.0% +0.0% +0.0% +0.0% nucleic2 +0.1% 0.0% +0.0% +0.0% +0.0% para +0.1% 0.0% 0.0% +0.0% +0.0% paraffins +0.1% 0.0% +0.0% -0.0% 0.0% parser +0.1% 0.0% -0.0% -0.0% -0.0% parstof +0.1% 0.0% +0.0% +0.0% +0.0% pic +0.1% 0.0% -0.0% -0.0% 0.0% pidigits +0.1% 0.0% +0.0% -0.0% -0.0% power +0.1% 0.0% +0.0% +0.0% +0.0% pretty +0.1% 0.0% -0.0% -0.0% -0.1% primes +0.1% 0.0% -0.0% -0.0% -0.0% primetest +0.1% 0.0% -0.0% -0.0% -0.0% prolog +0.1% 0.0% -0.0% -0.0% -0.0% puzzle +0.1% 0.0% -0.0% -0.0% -0.0% queens +0.1% 0.0% +0.0% +0.0% +0.0% reptile +0.1% 0.0% -0.0% -0.0% +0.0% reverse-complem +0.1% 0.0% +0.0% 0.0% -0.0% rewrite +0.1% 0.0% -0.0% -0.0% -0.0% rfib +0.1% 0.0% +0.0% +0.0% +0.0% rsa +0.1% 0.0% -0.0% +0.0% -0.0% scc +0.1% 0.0% -0.0% -0.0% -0.1% sched +0.1% 0.0% +0.0% +0.0% +0.0% scs +0.1% 0.0% +0.0% +0.0% +0.0% simple +0.1% 0.0% -0.0% -0.0% -0.0% solid +0.1% 0.0% +0.0% +0.0% +0.0% sorting +0.1% 0.0% -0.0% -0.0% -0.0% spectral-norm +0.1% 0.0% +0.0% +0.0% +0.0% sphere +0.1% 0.0% -0.0% -0.0% -0.0% symalg +0.1% 0.0% -0.0% -0.0% -0.0% tak +0.1% 0.0% +0.0% +0.0% +0.0% transform +0.1% 0.0% +0.0% +0.0% +0.0% treejoin +0.1% 0.0% +0.0% -0.0% -0.0% typecheck +0.1% 0.0% +0.0% +0.0% +0.0% veritas +0.0% 0.0% +0.0% +0.0% +0.0% wang +0.1% 0.0% 0.0% +0.0% +0.0% wave4main +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve1 +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve2 +0.1% 0.0% +0.0% +0.0% +0.0% x2n1 +0.1% 0.0% +0.0% +0.0% +0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -0.0% -0.1% Max +0.1% 0.0% +0.0% +0.0% +0.0% Geometric Mean +0.1% -0.0% -0.0% -0.0% -0.0% Bumping numbers of nonsensical perf tests: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 It's simply not possible for this patch to increase allocations, and I've wasted enough time on these test in the past (see #17686). I think these tests should not be perf tests, but for now I'll bump the numbers. - - - - - dce50062 by Sylvain Henry at 2020-04-09T16:18:44-04:00 Rts: show errno on failure (#18033) - - - - - 045139f4 by Hécate at 2020-04-09T23:10:44-04:00 Add an example to liftIO and explain its purpose - - - - - 101fab6e by Sebastian Graf at 2020-04-09T23:11:21-04:00 Special case `isConstraintKindCon` on `AlgTyCon` Previously, the `tyConUnique` record selector would unfold into a huge case expression that would be inlined in all call sites, such as the `INLINE`-annotated `coreView`, see #18026. `constraintKindTyConKey` only occurs as the `Unique` of an `AlgTyCon` anyway, so we can make the code a lot more compact, but have to move it to GHC.Core.TyCon. Metric Decrease: T12150 T12234 - - - - - f5212dfc by Sebastian Graf at 2020-04-09T23:11:57-04:00 DmdAnal: No need to attach a StrictSig to DataCon workers In GHC.Types.Id.Make we were giving a strictness signature to every data constructor wrapper Id that we weren't looking at in demand analysis anyway. We used to use its CPR info, but that has its own CPR signature now. `Note [Data-con worker strictness]` then felt very out of place, so I moved it to GHC.Core.DataCon. - - - - - 75a185dc by Sylvain Henry at 2020-04-09T23:12:37-04:00 Hadrian: fix --summary - - - - - 723062ed by Ömer Sinan Ağacan at 2020-04-10T09:18:14+03:00 testsuite: Move no_lint to the top level, tweak hie002 - We don't want to benchmark linting so disable lints in hie002 perf test - Move no_lint to the top-level to be able to use it in tests other than those in `testsuite/tests/perf/compiler`. - Filter out -dstg-lint in no_lint. - hie002 allocation numbers on 32-bit are unstable, so skip it on 32-bit Metric Decrease: hie002 ManyConstructors T12150 T12234 T13035 T1969 T4801 T9233 T9961 - - - - - bcafaa82 by Peter Trommler at 2020-04-10T19:29:33-04:00 Testsuite: mark T11531 fragile The test depends on a link editor allowing undefined symbols in an ELF shared object. This is the standard but it seems some distributions patch their link editor. See the report by @hsyl20 in #11531. Fixes #11531 - - - - - 0889f5ee by Takenobu Tani at 2020-04-12T11:44:52+09:00 testsuite: Fix comment for a language extension [skip ci] - - - - - cd4f92b5 by Simon Peyton Jones at 2020-04-12T11:20:58-04:00 Significant refactor of Lint This refactoring of Lint was triggered by #17923, which is fixed by this patch. The main change is this. Instead of lintType :: Type -> LintM LintedKind we now have lintType :: Type -> LintM LintedType Previously, all of typeKind was effectively duplicate in lintType. Moreover, since we have an ambient substitution, we still had to apply the substition here and there, sometimes more than once. It was all very tricky, in the end, and made my head hurt. Now, lintType returns a fully linted type, with all substitutions performed on it. This is much simpler. The same thing is needed for Coercions. Instead of lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) we now have lintCoercion :: Coercion -> LintM LintedCoercion Much simpler! The code is shorter and less bug-prone. There are a lot of knock on effects. But life is now better. Metric Decrease: T1969 - - - - - 0efaf301 by Josh Meredith at 2020-04-12T11:21:34-04:00 Implement extensible interface files - - - - - 54ca66a7 by Ryan Scott at 2020-04-12T11:22:10-04:00 Use conLikeUserTyVarBinders to quantify field selector types This patch: 1. Writes up a specification for how the types of top-level field selectors should be determined in a new section of the GHC User's Guide, and 2. Makes GHC actually implement that specification by using `conLikeUserTyVarBinders` in `mkOneRecordSelector` to preserve the order and specificity of type variables written by the user. Fixes #18023. - - - - - 35799dda by Ben Gamari at 2020-04-12T11:22:50-04:00 hadrian: Don't --export-dynamic on Darwin When fixing #17962 I neglected to consider that --export-dynamic is only supported on ELF platforms. - - - - - e8029816 by Alexis King at 2020-04-12T11:23:27-04:00 Add an INLINE pragma to Control.Category.>>> This fixes #18013 by adding INLINE pragmas to both Control.Category.>>> and GHC.Desugar.>>>. The functional change in this patch is tiny (just two lines of pragmas!), but an accompanying Note explains in gory detail what’s going on. - - - - - 0da186c1 by Krzysztof Gogolewski at 2020-04-14T07:55:20-04:00 Change zipWith to zipWithEqual in a few places - - - - - 074c1ccd by Andreas Klebinger at 2020-04-14T07:55:55-04:00 Small change to the windows ticker. We already have a function to go from time to ms so use it. Also expand on the state of timer resolution. - - - - - b69cc884 by Alp Mestanogullari at 2020-04-14T07:56:38-04:00 hadrian: get rid of unnecessary levels of nesting in source-dist - - - - - d0c3b069 by Julien Debon at 2020-04-14T07:57:16-04:00 doc (Foldable): Add examples to Data.Foldable See #17929 - - - - - 5b08e0c0 by Ben Gamari at 2020-04-14T23:28:20-04:00 StgCRun: Enable unwinding only on Linux It's broken on macOS due and SmartOS due to assembler differences (#15207) so let's be conservative in enabling it. Also, refactor things to make the intent clearer. - - - - - 27cc2e7b by Ben Gamari at 2020-04-14T23:28:57-04:00 rts: Don't mark evacuate_large as inline This function has two callsites and is quite large. GCC consequently decides not to inline and warns instead. Given the situation, I can't blame it. Let's just remove the inline specifier. - - - - - 9853fc5e by Ben Gamari at 2020-04-14T23:29:48-04:00 base: Enable large file support for OFD locking impl. Not only is this a good idea in general but this should also avoid issue #17950 by ensuring that off_t is 64-bits. - - - - - 7b41f21b by Matthew Pickering at 2020-04-14T23:30:24-04:00 Hadrian: Make -i paths absolute The primary reason for this change is that ghcide does not work with relative paths. It also matches what cabal and stack do, they always pass absolute paths. - - - - - 41230e26 by Daniel Gröber at 2020-04-14T23:31:01-04:00 Zero out pinned block alignment slop when profiling The heap profiler currently cannot traverse pinned blocks because of alignment slop. This used to just be a minor annoyance as the whole block is accounted into a special cost center rather than the respective object's CCS, cf. #7275. However for the new root profiler we would like to be able to visit _every_ closure on the heap. We need to do this so we can get rid of the current 'flip' bit hack in the heap traversal code. Since info pointers are always non-zero we can in principle skip all the slop in the profiler if we can rely on it being zeroed. This assumption caused problems in the past though, commit a586b33f8e ("rts: Correct handling of LARGE ARR_WORDS in LDV profiler"), part of !1118, tried to use the same trick for BF_LARGE objects but neglected to take into account that shrink*Array# functions don't ensure that slop is zeroed when not compiling with profiling. Later, commit 0c114c6599 ("Handle large ARR_WORDS in heap census (fix as we will only be assuming slop is zeroed when profiling is on. This commit also reduces the ammount of slop we introduce in the first place by calculating the needed alignment before doing the allocation for small objects where we know the next available address. For large objects we don't know how much alignment we'll have to do yet since those details are hidden behind the allocateMightFail function so there we continue to allocate the maximum additional words we'll need to do the alignment. So we don't have to duplicate all this logic in the cmm code we pull it into the RTS allocatePinned function instead. Metric Decrease: T7257 haddock.Cabal haddock.base - - - - - 15fa9bd6 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Expand and add more notes regarding slop - - - - - caf3f444 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: allocatePinned: Fix confusion about word/byte units - - - - - c3c0f662 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Underline some Notes as is conventional - - - - - e149dea9 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Fix nomenclature in OVERWRITING_CLOSURE macros The additional commentary introduced by commit 8916e64e5437 ("Implement shrinkSmallMutableArray# and resizeSmallMutableArray#.") unfortunately got this wrong. We set 'prim' to true in overwritingClosureOfs because we _don't_ want to call LDV_recordDead(). The reason is because of this "inherently used" distinction made in the LDV profiler so I rename the variable to be more appropriate. - - - - - 1dd3d18c by Daniel Gröber at 2020-04-14T23:31:38-04:00 Remove call to LDV_RECORD_CREATE for array resizing - - - - - 19de2fb0 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Assert LDV_recordDead is not called for inherently used closures The comments make it clear LDV_recordDead should not be called for inhererently used closures, so add an assertion to codify this fact. - - - - - 0b934e30 by Ryan Scott at 2020-04-14T23:32:14-04:00 Bump template-haskell version to 2.17.0.0 This requires bumping the `exceptions` and `text` submodules to bring in commits that bump their respective upper version bounds on `template-haskell`. Fixes #17645. Fixes #17696. Note that the new `text` commit includes a fair number of additions to the Haddocks in that library. As a result, Haddock has to do more work during the `haddock.Cabal` test case, increasing the number of allocations it requires. Therefore, ------------------------- Metric Increase: haddock.Cabal ------------------------- - - - - - 22cc8e51 by Ryan Scott at 2020-04-15T17:48:47-04:00 Fix #18052 by using pprPrefixOcc in more places This fixes several small oversights in the choice of pretty-printing function to use. Fixes #18052. - - - - - ec77b2f1 by Daniel Gröber at 2020-04-15T17:49:24-04:00 rts: ProfHeap: Fix wrong time in last heap profile sample We've had this longstanding issue in the heap profiler, where the time of the last sample in the profile is sometimes way off causing the rendered graph to be quite useless for long runs. It seems to me the problem is that we use mut_user_time() for the last sample as opposed to getRTSStats(), which we use when calling heapProfile() in GC.c. The former is equivalent to getProcessCPUTime() but the latter does some additional stuff: getProcessCPUTime() - end_init_cpu - stats.gc_cpu_ns - stats.nonmoving_gc_cpu_ns So to fix this just use getRTSStats() in both places. - - - - - 85fc32f0 by Sylvain Henry at 2020-04-17T12:45:25-04:00 Hadrian: fix dyn_o/dyn_hi rule (#17534) - - - - - bfde3b76 by Ryan Scott at 2020-04-17T12:46:02-04:00 Fix #18065 by fixing an InstCo oversight in Core Lint There was a small thinko in Core Lint's treatment of `InstCo` coercions that ultimately led to #18065. The fix: add an apostrophe. That's it! Fixes #18065. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> - - - - - a05348eb by Cale Gibbard at 2020-04-17T13:08:47-04:00 Change the fail operator argument of BindStmt to be a Maybe Don't use noSyntaxExpr for it. There is no good way to defensively case on that, nor is it clear one ought to do so. - - - - - 79e27144 by John Ericson at 2020-04-17T13:08:47-04:00 Use trees that grow for rebindable operators for `<-` binds Also add more documentation. - - - - - 18bc16ed by Cale Gibbard at 2020-04-17T13:08:47-04:00 Use FailOperator in more places, define a couple datatypes (XBindStmtRn and XBindStmtTc) to help clarify the meaning of XBindStmt in the renamer and typechecker - - - - - 84cc8394 by Simon Peyton Jones at 2020-04-18T13:20:29-04:00 Add a missing zonk in tcHsPartialType I omitted a vital zonk when refactoring tcHsPartialType in commit 48fb3482f8cbc8a4b37161021e846105f980eed4 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Wed Jun 5 08:55:17 2019 +0100 Fix typechecking of partial type signatures This patch fixes it and adds commentary to explain why. Fixes #18008 - - - - - 2ee96ac1 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Bump FreeBSD bootstrap compiler to 8.10.1 - - - - - 434312e5 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Enable FreeBSD job for so-labelled MRs - - - - - ddffb227 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Use rules syntax for conditional jobs - - - - - e2586828 by Ben Gamari at 2020-04-18T13:21:05-04:00 Bump hsc2hs submodule - - - - - 15ab6cd5 by Ömer Sinan Ağacan at 2020-04-18T13:21:44-04:00 Improve prepForeignCall error reporting Show parameters and description of the error code when ffi_prep_cif fails. This may be helpful for debugging #17018. - - - - - 3ca52151 by Sylvain Henry at 2020-04-18T20:04:14+02:00 GHC.Core.Opt renaming * GHC.Core.Op => GHC.Core.Opt * GHC.Core.Opt.Simplify.Driver => GHC.Core.Opt.Driver * GHC.Core.Opt.Tidy => GHC.Core.Tidy * GHC.Core.Opt.WorkWrap.Lib => GHC.Core.Opt.WorkWrap.Utils As discussed in: * https://mail.haskell.org/pipermail/ghc-devs/2020-April/018758.html * https://gitlab.haskell.org/ghc/ghc/issues/13009#note_264650 - - - - - 15312bbb by Sylvain Henry at 2020-04-18T20:04:46+02:00 Modules (#13009) * SysTools * Parser * GHC.Builtin * GHC.Iface.Recomp * Settings Update Haddock submodule Metric Decrease: Naperian parsing001 - - - - - eaed0a32 by Alexis King at 2020-04-19T03:16:44-04:00 Add missing addInScope call for letrec binders in OccurAnal This fixes #18044, where a shadowed variable was incorrectly substituted by the binder swap on the RHS of a floated-in letrec. This can only happen when the uniques line up *just* right, so writing a regression test would be very difficult, but at least the fix is small and straightforward. - - - - - 36882493 by Shayne Fletcher at 2020-04-20T04:36:43-04:00 Derive Ord instance for Extension Metric Increase: T12150 T12234 - - - - - b43365ad by Simon Peyton Jones at 2020-04-20T04:37:20-04:00 Fix a buglet in redundant-constraint warnings Ticket #18036 pointed out that we were reporting a redundant constraint when it really really wasn't. Turned out to be a buglet in the SkolemInfo for the relevant implication constraint. Easily fixed! - - - - - d5fae7da by Ömer Sinan Ağacan at 2020-04-20T14:39:28-04:00 Mark T12010 fragile on 32-bit - - - - - bca02fca by Adam Sandberg Ericsson at 2020-04-21T06:38:45-04:00 docs: drop note about not supporting shared libraries on unix systems [skip ci] - - - - - 6655f933 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Use ParserFlags in GHC.Runtime.Eval (#17957) Instead of passing `DynFlags` to functions such as `isStmt` and `hasImport` in `GHC.Runtime.Eval` we pass `ParserFlags`. It's a much simpler structure that can be created purely with `mkParserFlags'`. - - - - - 70be0fbc by Sylvain Henry at 2020-04-21T06:39:32-04:00 GHC.Runtime: avoid DynFlags (#17957) * add `getPlatform :: TcM Platform` helper * remove unused `DynFlags` parameter from `emptyPLS` - - - - - 35e43d48 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid DynFlags in Ppr code (#17957) * replace `DynFlags` parameters with `SDocContext` parameters for a few Ppr related functions: `bufLeftRenderSDoc`, `printSDoc`, `printSDocLn`, `showSDocOneLine`. * remove the use of `pprCols :: DynFlags -> Int` in Outputable. We already have the information via `sdocLineLength :: SDocContext -> Int` - - - - - ce5c2999 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid using sdocWithDynFlags (#17957) Remove one use of `sdocWithDynFlags` from `GHC.CmmToLlvm.llvmCodeGen'` and from `GHC.Driver.CodeOutput.profilingInitCode` - - - - - f2a98996 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid `sdocWithDynFlags` in `pprCLbl` (#17957) * add a `DynFlags` parameter to `pprCLbl` * put `maybe_underscore` and `pprAsmCLbl` in a `where` clause to avoid `DynFlags` parameters - - - - - 747093b7 by Sylvain Henry at 2020-04-21T06:39:32-04:00 CmmToAsm DynFlags refactoring (#17957) * Remove `DynFlags` parameter from `isDynLinkName`: `isDynLinkName` used to test the global `ExternalDynamicRefs` flag. Now we test it outside of `isDynLinkName` * Add new fields into `NCGConfig`: current unit id, sse/bmi versions, externalDynamicRefs, etc. * Replace many uses of `DynFlags` by `NCGConfig` * Moved `BMI/SSE` datatypes into `GHC.Platform` - - - - - ffd7eef2 by Takenobu Tani at 2020-04-22T23:09:50-04:00 stg-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Stg/Syntax.hs <= stgSyn/StgSyn.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/CostCentre.hs <= profiling/CostCentre.hs This patch also updates old file path [2]: * utils/genapply/Main.hs <= utils/genapply/GenApply.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: commit 0cc4aad36f [skip ci] - - - - - e8a5d81b by Jonathan DK Gibbons at 2020-04-22T23:10:28-04:00 Refactor the `MatchResult` type in the desugarer This way, it does a better job of proving whether or not the fail operator is used. - - - - - dcb7fe5a by John Ericson at 2020-04-22T23:10:28-04:00 Remove panic in dsHandleMonadicFailure Rework dsHandleMonadicFailure to be correct by construction instead of using an unreachable panic. - - - - - cde23cd4 by John Ericson at 2020-04-22T23:10:28-04:00 Inline `adjustMatchResult` It is just `fmap` - - - - - 72cb6bcc by John Ericson at 2020-04-22T23:10:28-04:00 Generalize type of `matchCanFail` - - - - - 401f7bb3 by John Ericson at 2020-04-22T23:10:28-04:00 `MatchResult'` -> `MatchResult` Inline `MatchResult` alias accordingly. - - - - - 6c9fae23 by Alexis King at 2020-04-22T23:11:12-04:00 Mark DataCon wrappers CONLIKE Now that DataCon wrappers don’t inline until phase 0 (see commit b78cc64e923716ac0512c299f42d4d0012306c05), it’s important that case-of-known-constructor and RULE matching be able to see saturated applications of DataCon wrappers in unfoldings. Making them conlike is a natural way to do it, since they are, in fact, precisely the sort of thing the CONLIKE pragma exists to solve. Fixes #18012. This also bumps the version of the parsec submodule to incorporate a patch that avoids a metric increase on the haddock perf tests. The increase was not really a flaw in this patch, as parsec was implicitly relying on inlining heuristics. The patch to parsec just adds some INLINABLE pragmas, and we get a nice performance bump out of it (well beyond the performance we lost from this patch). Metric Decrease: T12234 WWRec haddock.Cabal haddock.base haddock.compiler - - - - - 48b8951e by Roland Senn at 2020-04-22T23:11:51-04:00 Fix tab-completion for :break (#17989) In tab-completion for the `:break` command, only those identifiers should be shown, that are accepted in the `:break` command. Hence these identifiers must be - defined in an interpreted module - top-level - currently in scope - listed in a `ModBreaks` value as a possible breakpoint. The identifiers my be qualified or unqualified. To get all possible top-level breakpoints for tab-completeion with the correct qualification do: 1. Build the list called `pifsBreaks` of all pairs of (Identifier, module-filename) from the `ModBreaks` values. Here all identifiers are unqualified. 2. Build the list called `pifInscope` of all pairs of (Identifiers, module-filename) with identifiers from the `GlobalRdrEnv`. Take only those identifiers that are in scope and have the correct prefix. Here the identifiers may be qualified. 3. From the `pifInscope` list seclect all pairs that can be found in the `pifsBreaks` list, by comparing only the unqualified part of the identifier. The remaining identifiers can be used for tab-completion. This ensures, that we show only identifiers, that can be used in a `:break` command. - - - - - 34a45ee6 by Peter Trommler at 2020-04-22T23:12:27-04:00 PPC NCG: Add DWARF constants and debug labels Fixes #11261 - - - - - ffde2348 by Simon Peyton Jones at 2020-04-22T23:13:06-04:00 Do eager instantation in terms This patch implements eager instantiation, a small but critical change to the type inference engine, #17173. The main change is this: When inferring types, always return an instantiated type (for now, deeply instantiated; in future shallowly instantiated) There is more discussion in https://www.tweag.io/posts/2020-04-02-lazy-eager-instantiation.html There is quite a bit of refactoring in this patch: * The ir_inst field of GHC.Tc.Utils.TcType.InferResultk has entirely gone. So tcInferInst and tcInferNoInst have collapsed into tcInfer. * Type inference of applications, via tcInferApp and tcInferAppHead, are substantially refactored, preparing the way for Quick Look impredicativity. * New pure function GHC.Tc.Gen.Expr.collectHsArgs and applyHsArgs are beatifully dual. We can see the zipper! * GHC.Tc.Gen.Expr.tcArgs is now much nicer; no longer needs to return a wrapper * In HsExpr, HsTypeApp now contains the the actual type argument, and is used in desugaring, rather than putting it in a mysterious wrapper. * I struggled a bit with good error reporting in Unify.matchActualFunTysPart. It's a little bit simpler than before, but still not great. Some smaller things * Rename tcPolyExpr --> tcCheckExpr tcMonoExpr --> tcLExpr * tcPatSig moves from GHC.Tc.Gen.HsType to GHC.Tc.Gen.Pat Metric Decrease: T9961 Reduction of 1.6% in comiler allocation on T9961, I think. - - - - - 6f84aca3 by Ben Gamari at 2020-04-22T23:13:43-04:00 rts: Ensure that sigaction structs are initialized I noticed these may have uninitialized fields when looking into #18037. The reporter says that zeroing them doesn't fix the MSAN failures they observe but zeroing them is the right thing to do regardless. - - - - - c29f0fa6 by Andreas Klebinger at 2020-04-22T23:14:21-04:00 Add "ddump-cmm-opt" as alias for "ddump-opt-cmm". - - - - - 4b4a8b60 by Ben Gamari at 2020-04-22T23:14:57-04:00 llvmGen: Remove -fast-llvm flag Issue #18076 drew my attention to the undocumented `-fast-llvm` flag for the LLVM code generator introduced in 22733532171330136d87533d523f565f2a4f102f. Speaking to Moritz about this, the motivation for this flag was to avoid potential incompatibilities between LLVM and the assembler/linker toolchain by making LLVM responsible for machine-code generation. Unfortunately, this cannot possibly work: the LLVM backend's mangler performs a number of transforms on the assembler generated by LLVM that are necessary for correctness. These are currently: * mangling Haskell functions' symbol types to be `object` instead of `function` on ELF platforms (necessary for tables-next-to-code) * mangling AVX instructions to ensure that we don't assume alignment (which LLVM otherwise does) * mangling Darwin's subsections-via-symbols directives Given that these are all necessary I don't believe that we can support `-fast-llvm`. Let's rather remove it. - - - - - 831b6642 by Moritz Angermann at 2020-04-22T23:15:33-04:00 Fix build warning; add more informative information to the linker; fix linker for empty sections - - - - - c409961a by Ryan Scott at 2020-04-22T23:16:12-04:00 Update commentary and slightly refactor GHC.Tc.Deriv.Infer There was some out-of-date commentary in `GHC.Tc.Deriv.Infer` that has been modernized. Along the way, I removed the `bad` constraints in `simplifyDeriv`, which did not serve any useful purpose (besides being printed in debugging output). Fixes #18073. - - - - - 125aa2b8 by Ömer Sinan Ağacan at 2020-04-22T23:16:51-04:00 Remove leftover comment in tcRnModule', redundant bind The code for the comment was moved in dc8c03b2a5c but the comment was forgotten. - - - - - 8ea37b01 by Sylvain Henry at 2020-04-22T23:17:34-04:00 RTS: workaround a Linux kernel bug in timerfd Reading a timerfd may return 0: https://lkml.org/lkml/2019/8/16/335. This is currently undocumented behavior and documentation "won't happen anytime soon" (https://lkml.org/lkml/2020/2/13/295). With this patch, we just ignore the result instead of crashing. It may fix #18033 but we can't be sure because we don't have enough information. See also this discussion about the kernel bug: https://github.com/Azure/sonic-swss-common/pull/302/files/1f070e7920c2e5d63316c0105bf4481e73d72dc9 - - - - - cd8409c2 by Ryan Scott at 2020-04-23T11:39:24-04:00 Create di_scoped_tvs for associated data family instances properly See `Note [Associated data family instances and di_scoped_tvs]` in `GHC.Tc.TyCl.Instance`, which explains all of the moving parts. Fixes #18055. - - - - - 339e8ece by Ben Gamari at 2020-04-23T11:40:02-04:00 hadrian/ghci: Allow arguments to be passed to GHCi Previously the arguments passed to hadrian/ghci were passed both to `hadrian` and GHCi. This is rather odd given that there are essentially not arguments in the intersection of the two. Let's just pass them to GHCi; this allows `hadrian/ghci -Werror`. - - - - - 5946c85a by Ben Gamari at 2020-04-23T11:40:38-04:00 testsuite: Don't attempt to read .std{err,out} files if they don't exist Simon reports that he was previously seeing framework failures due to an attempt to read the non-existing T13456.stderr. While I don't know exactly what this is due to, it does seem like a non-existing .std{out,err} file should be equivalent to an empty file. Teach the testsuite driver to treat it as such. - - - - - c42754d5 by John Ericson at 2020-04-23T18:32:43-04:00 Trees That Grow refactor for `ConPat` and `CoPat` - `ConPat{In,Out}` -> `ConPat` - `CoPat` -> `XPat (CoPat ..)` Note that `GHC.HS.*` still uses `HsWrap`, but only when `p ~ GhcTc`. After this change, moving the type family instances out of `GHC.HS.*` is sufficient to break the cycle. Add XCollectPat class to decide how binders are collected from XXPat based on the pass. Previously we did this with IsPass, but that doesn't work for Haddock's DocNameI, and the constraint doesn't express what actual distinction is being made. Perhaps a class for collecting binders more generally is in order, but we haven't attempted this yet. Pure refactor of code around ConPat - InPat/OutPat synonyms removed - rename several identifiers - redundant constraints removed - move extension field in ConPat to be first - make ConPat use record syntax more consistently Fix T6145 (ConPatIn became ConPat) Add comments from SPJ. Add comment about haddock's use of CollectPass. Updates haddock submodule. - - - - - 72da0c29 by mniip at 2020-04-23T18:33:21-04:00 Add :doc to GHC.Prim - - - - - 2c23e2e3 by mniip at 2020-04-23T18:33:21-04:00 Include docs for non-primop entries in primops.txt as well - - - - - 0ac29c88 by mniip at 2020-04-23T18:33:21-04:00 GHC.Prim docs: note and test - - - - - b0fbfc75 by John Ericson at 2020-04-24T12:07:14-04:00 Switch order on `GhcMake.IsBoot` In !1798 we were requested to replace many `Bool`s with this data type. But those bools had `False` meaning `NotBoot`, so the `Ord` instance would be flipped if we use this data-type as-is. Since the planned formally-`Bool` occurrences vastly outnumber the current occurrences, we figured it would be better to conform the `Ord` instance to how the `Bool` is used now, fixing any issues, rather than fix them currently with the bigger refactor later in !1798. That way, !1798 can be a "pure" refactor with no behavioral changes. - - - - - af332442 by Sylvain Henry at 2020-04-26T13:55:14-04:00 Modules: Utils and Data (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - cd4434c8 by Sylvain Henry at 2020-04-26T13:55:16-04:00 Fix misleading Ptr phantom type in SerializedCompact (#15653) - - - - - 22bf5c73 by Ömer Sinan Ağacan at 2020-04-26T13:55:22-04:00 Tweak includes in non-moving GC headers We don't use hash tables in non-moving GC so remove the includes. This breaks Compact.c as existing includes no longer include Hash.h, so include Hash.h explicitly in Compact.c. - - - - - 99823ed2 by Sylvain Henry at 2020-04-27T20:24:46-04:00 TH: fix Show/Eq/Ord instances for Bytes (#16457) We shouldn't compare pointer values but the actual bytes. - - - - - c62271a2 by Alp Mestanogullari at 2020-04-27T20:25:33-04:00 hadrian: always capture both stdout and stderr when running a builder fails The idea being that when a builder('s command) fails, we quite likely want to have all the information available to figure out why. Depending on the builder _and_ the particular problem, the useful bits of information can be printed on stdout or stderr. We accomplish this by defining a simple wrapper for Shake's `cmd` function, that just _always_ captures both streams in case the command returns a non-zero exit code, and by using this wrapper everywhere in `hadrian/src/Builder.hs`. Fixes #18089. - - - - - 4b9764db by Ryan Scott at 2020-04-28T15:40:04-04:00 Define a Quote IO instance Fixes #18103. - - - - - 518a63d4 by Ryan Scott at 2020-04-28T15:40:42-04:00 Make boxed 1-tuples have known keys Unlike other tuples, which use special syntax and are "known" by way of a special `isBuiltInOcc_maybe` code path, boxed 1-tuples do not use special syntax. Therefore, in order to make sure that the internals of GHC are aware of the `data Unit a = Unit a` definition in `GHC.Tuple`, we give `Unit` known keys. For the full details, see `Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)` in `GHC.Builtin.Types`. Fixes #18097. - - - - - 2cfc4ab9 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Document backpack fields in DynFlags - - - - - 10a2ba90 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo * Rename InstalledPackageInfo into GenericUnitInfo The name InstalledPackageInfo is only kept for alleged backward compatibility reason in Cabal. ghc-boot has its own stripped down copy of this datatype but it doesn't need to keep the name. Internally we already use type aliases (UnitInfo in GHC, PackageCacheFormat in ghc-pkg). * Rename UnitInfo fields: add "unit" prefix and fix misleading names * Add comments on every UnitInfo field * Rename SourcePackageId into PackageId "Package" already indicates that it's a "source package". Installed package components are called units. Update Haddock submodule - - - - - 69562e34 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Remove unused `emptyGenericUnitInfo` - - - - - 9e2c8e0e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo load/store from databases Converting between UnitInfo stored in package databases and UnitInfo as they are used in ghc-pkg and ghc was done in a very convoluted way (via BinaryStringRep and DbUnitModuleRep type classes using fun deps, etc.). It was difficult to understand and even more to modify (I wanted to try to use a GADT for UnitId but fun deps got in the way). The new code uses much more straightforward functions to convert between the different representations. Much simpler. - - - - - ea717aa4 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Factorize mungePackagePaths code This patch factorizes the duplicated code used in ghc-pkg and in GHC to munge package paths/urls. It also fixes haddock-html munging in GHC (allowed to be either a file or a url) to mimic ghc-pkg behavior. - - - - - 10d15f1e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactoring unit management code Over the years the unit management code has been modified a lot to keep up with changes in Cabal (e.g. support for several library components in the same package), to integrate BackPack, etc. I found it very hard to understand as the terminology wasn't consistent, was referring to past concepts, etc. The terminology is now explained as clearly as I could in the Note "About Units" and the code is refactored to reflect it. ------------------- Many names were misleading: UnitId is not an Id but could be a virtual unit (an indefinite one instantiated on the fly), IndefUnitId constructor may contain a definite instantiated unit, etc. * Rename IndefUnitId into InstantiatedUnit * Rename IndefModule into InstantiatedModule * Rename UnitId type into Unit * Rename IndefiniteUnitId constructor into VirtUnit * Rename DefiniteUnitId constructor into RealUnit * Rename packageConfigId into mkUnit * Rename getPackageDetails into unsafeGetUnitInfo * Rename InstalledUnitId into UnitId Remove references to misleading ComponentId: a ComponentId is just an indefinite unit-id to be instantiated. * Rename ComponentId into IndefUnitId * Rename ComponentDetails into UnitPprInfo * Fix display of UnitPprInfo with empty version: this is now used for units dynamically generated by BackPack Generalize several types (Module, Unit, etc.) so that they can be used with different unit identifier types: UnitKey, UnitId, Unit, etc. * GenModule: Module, InstantiatedModule and InstalledModule are now instances of this type * Generalize DefUnitId, IndefUnitId, Unit, InstantiatedUnit, PackageDatabase Replace BackPack fake "hole" UnitId by a proper HoleUnit constructor. Add basic support for UnitKey. They should be used more in the future to avoid mixing them up with UnitId as we do now. Add many comments. Update Haddock submodule - - - - - 8bfb0219 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Unit: split and rename modules Introduce GHC.Unit.* hierarchy for everything concerning units, packages and modules. Update Haddock submodule - - - - - 71484b09 by Alexis King at 2020-04-30T01:57:35-04:00 Allow block arguments in arrow control operators Arrow control operators have their own entries in the grammar, so they did not cooperate with BlockArguments. This was just a minor oversight, so this patch adjusts the grammar to add the desired behavior. fixes #18050 - - - - - a48cd2a0 by Alexis King at 2020-04-30T01:57:35-04:00 Allow LambdaCase to be used as a command in proc notation - - - - - f4d3773c by Alexis King at 2020-04-30T01:57:35-04:00 Document BlockArguments/LambdaCase support in arrow notation - - - - - 5bdfdd13 by Simon Peyton Jones at 2020-04-30T01:58:15-04:00 Add tests for #17873 - - - - - 19b701c2 by Simon Peyton Jones at 2020-04-30T07:30:13-04:00 Mark rule args as non-tail-called This was just an omission...b I'd failed to call markAllNonTailCall on rule args. I think this bug has been here a long time, but it's quite hard to trigger. Fixes #18098 - - - - - 014ef4a3 by Matthew Pickering at 2020-04-30T07:30:50-04:00 Hadrian: Improve tool-args command to support more components There is a new command to hadrian, tool:path/to/file.hs, which returns the options needed to compile that file in GHCi. This is now used in the ghci script with argument `ghc/Main.hs` but its main purpose is to support the new multi-component branch of ghcide. - - - - - 2aa67611 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Clear bitmap after initializing block size Previously nonmovingInitSegment would clear the bitmap before initializing the segment's block size. This is broken since nonmovingClearBitmap looks at the segment's block size to determine how much bitmap to clear. - - - - - 54dad3cf by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Explicitly memoize block count A profile cast doubt on whether the compiler hoisted the bound out the loop as I would have expected here. It turns out it did but nevertheless it seems clearer to just do this manually. - - - - - 99ff8145 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Eagerly flush all capabilities' update remembered sets (cherry picked from commit 2fa79119570b358a4db61446396889b8260d7957) - - - - - 05b0a9fd by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 Remove OneShotInfo field of LFReEntrant, document OneShotInfo The field is only used in withNewTickyCounterFun and it's easier to directly pass a parameter for one-shot info to withNewTickyCounterFun instead of passing it via LFReEntrant. This also makes !2842 simpler. Other changes: - New Note (by SPJ) [OneShotInfo overview] added. - Arity argument of thunkCode removed as it's always 0. - - - - - a43620c6 by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 GHC.StgToCmm.Ticky: remove a few unused stuff - - - - - 780de9e1 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Use platform in Iface Binary - - - - - f8386c7b by Sylvain Henry at 2020-05-01T10:37:39-04:00 Refactor PprDebug handling If `-dppr-debug` is set, then PprUser and PprDump styles are silently replaced with PprDebug style. This was done in `mkUserStyle` and `mkDumpStyle` smart constructors. As a consequence they needed a DynFlags parameter. Now we keep the original PprUser and PprDump styles until they are used to create an `SDocContext`. I.e. the substitution is only performed in `initSDocContext`. - - - - - b3df9e78 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Remove PprStyle param of logging actions Use `withPprStyle` instead to apply a specific style to a SDoc. - - - - - de9fc995 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Fully remove PprDebug PprDebug was a pain to deal with consistently as it is implied by `-dppr-debug` but it isn't really a PprStyle. We remove it completely and query the appropriate SDoc flag instead (`sdocPprDebug`) via helpers (`getPprDebug` and its friends). - - - - - 8b51fcbd by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Only call checkSingle if we would report warnings - - - - - fd7ea0fe by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Pick up `EvVar`s bound in `HsWrapper`s for long-distance info `HsWrapper`s introduce evidence bindings through `WpEvLam` which the pattern-match coverage checker should be made aware of. Failing to do so caused #18049, where the resulting impreciseness of imcompleteness warnings seemingly contradicted with `-Winaccessible-code`. The solution is simple: Collect all the evidence binders of an `HsWrapper` and add it to the ambient `Deltas` before desugaring the wrapped expression. But that means we pick up many more evidence bindings, even when they wrap around code without a single pattern match to check! That regressed `T3064` by over 300%, so now we are adding long-distance info lazily through judicious use of `unsafeInterleaveIO`. Fixes #18049. - - - - - 7bfe9ac5 by Ben Gamari at 2020-05-03T04:41:33-04:00 rts: Enable tracing of nonmoving heap census with -ln Previously this was not easily available to the user. Fix this. Non-moving collection lifecycle events are now reported with -lg. - - - - - c560dd07 by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Move eventlog documentation users guide - - - - - 02543d5e by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Add documentation for non-moving GC events - - - - - b465dd45 by Alexis King at 2020-05-03T04:42:12-04:00 Flatten nested casts in the simple optimizer Normally, we aren’t supposed to generated any nested casts, since mkCast takes care to flatten them, but the simple optimizer didn’t use mkCast, so they could show up after inlining. This isn’t really a problem, since the simplifier will clean them up immediately anyway, but it can clutter the -ddump-ds output, and it’s an extremely easy fix. closes #18112 - - - - - 8bdc03d6 by Simon Peyton Jones at 2020-05-04T01:56:59-04:00 Don't return a panic in tcNestedSplice In GHC.Tc.Gen.Splice.tcNestedSplice we were returning a typechecked expression of "panic". That is usually OK, because the result is discarded. But it happens that tcApp now looks at the typechecked expression, trivially, to ask if it is tagToEnum. So being bottom is bad. Moreover a debug-trace might print it out. So better to return a civilised expression, even though it is usually discarded. - - - - - 0bf640b1 by Baldur Blöndal at 2020-05-04T01:57:36-04:00 Don't require parentheses around via type (`-XDerivingVia'). Fixes #18130". - - - - - 30272412 by Artem Pelenitsyn at 2020-05-04T13:19:59-04:00 Remove custom ExceptionMonad class (#18075) (updating haddock submodule accordingly) - - - - - b9f7c08f by jneira at 2020-05-04T13:20:37-04:00 Remove unused hs-boot file - - - - - 1d8f80cd by Sylvain Henry at 2020-05-05T03:22:46-04:00 Remove references to -package-key * remove references to `-package-key` which has been removed in 2016 (240ddd7c39536776e955e881d709bbb039b48513) * remove support for `-this-package-key` which has been deprecated at the same time - - - - - 7bc3a65b by Sylvain Henry at 2020-05-05T03:23:31-04:00 Remove SpecConstrAnnotation (#13681) This has been deprecated since 2013. Use GHC.Types.SPEC instead. Make GHC.Exts "not-home" for haddock Metric Decrease: haddock.base - - - - - 3c862f63 by DenisFrezzato at 2020-05-05T03:24:15-04:00 Fix Haskell98 short description in documentation - - - - - 2420c555 by Ryan Scott at 2020-05-05T03:24:53-04:00 Add regression tests for #16244, #16245, #16758 Commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70 ended up fixing quite a few bugs: * This commit fixes #16244 completely. A regression test has been added. * This commit fixes one program from #16245. (The program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211369 still panics, and the program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211400 still loops infinitely.) A regression test has been added for this program. * This commit fixes #16758. Accordingly, this patch removes the `expect_broken` label from the `T16758` test case, moves it from `should_compile` to `should_fail` (as it should produce an error message), and checks in the expected stderr. - - - - - 40c71c2c by Sylvain Henry at 2020-05-05T03:25:31-04:00 Fix colorized error messages (#18128) In b3df9e780fb2f5658412c644849cd0f1e6f50331 I broke colorized messages by using "dump" style instead of "user" style. This commits fixes it. - - - - - 7ab6ab09 by Richard Eisenberg at 2020-05-06T04:39:32-04:00 Refactor hole constraints. Previously, holes (both expression holes / out of scope variables and partial-type-signature wildcards) were emitted as *constraints* via the CHoleCan constructor. While this worked fine for error reporting, there was a fair amount of faff in keeping these constraints in line. In particular, and unlike other constraints, we could never change a CHoleCan to become CNonCanonical. In addition: * the "predicate" of a CHoleCan constraint was really the type of the hole, which is not a predicate at all * type-level holes (partial type signature wildcards) carried evidence, which was never used * tcNormalise (used in the pattern-match checker) had to create a hole constraint just to extract it again; it was quite messy The new approach is to record holes directly in WantedConstraints. It flows much more nicely now. Along the way, I did some cleaning up of commentary in GHC.Tc.Errors.Hole, which I had a hard time understanding. This was instigated by a future patch that will refactor the way predicates are handled. The fact that CHoleCan's "predicate" wasn't really a predicate is incompatible with that future patch. No test case, because this is meant to be purely internal. It turns out that this change improves the performance of the pattern-match checker, likely because fewer constraints are sloshing about in tcNormalise. I have not investigated deeply, but an improvement is not a surprise here: ------------------------- Metric Decrease: PmSeriesG ------------------------- - - - - - 420b957d by Ben Gamari at 2020-05-06T04:40:08-04:00 rts: Zero block flags with -DZ Block flags are very useful for determining the state of a block. However, some block allocator users don't touch them, leading to misleading values. Ensure that we zero then when zero-on-gc is set. This is safe and makes the flags more useful during debugging. - - - - - 740b3b8d by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix incorrect failed_to_evac value during deadlock gc Previously we would incorrectly set the failed_to_evac flag if we evacuated a value due to a deadlock GC. This would cause us to mark more things as dirty than strictly necessary. It also turned up a nasty but which I will fix next. - - - - - b2d72c75 by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix handling of dirty objects Previously we (incorrectly) relied on failed_to_evac to be "precise". That is, we expected it to only be true if *all* of an object's fields lived outside of the non-moving heap. However, does not match the behavior of failed_to_evac, which is true if *any* of the object's fields weren't promoted (meaning that some others *may* live in the non-moving heap). This is problematic as we skip the non-moving write barrier for dirty objects (which we can only safely do if *all* fields point outside of the non-moving heap). Clearly this arises due to a fundamental difference in the behavior expected of failed_to_evac in the moving and non-moving collector. e.g., in the moving collector it is always safe to conservatively say failed_to_evac=true whereas in the non-moving collector the safe value is false. This issue went unnoticed as I never wrote down the dirtiness invariant enforced by the non-moving collector. We now define this invariant as An object being marked as dirty implies that all of its fields are on the mark queue (or, equivalently, update remembered set). To maintain this invariant we teach nonmovingScavengeOne to push the fields of objects which we fail to evacuate to the update remembered set. This is a simple and reasonably cheap solution and avoids the complexity and fragility that other, more strict alternative invariants would require. All of this is described in a new Note, Note [Dirty flags in the non-moving collector] in NonMoving.c. - - - - - 9f3e6884 by Zubin Duggal at 2020-05-06T04:41:08-04:00 Allow atomic update of NameCache in readHieFile The situation arises in ghcide where multiple different threads may need to update the name cache, therefore with the older interface it could happen that you start reading a hie file with name cache A and produce name cache A + B, but another thread in the meantime updated the namecache to A + C. Therefore if you write the new namecache you will lose the A' updates from the second thread. Updates haddock submodule - - - - - edec6a6c by Ryan Scott at 2020-05-06T04:41:57-04:00 Make isTauTy detect higher-rank contexts Previously, `isTauTy` would only detect higher-rank `forall`s, not higher-rank contexts, which led to some minor bugs observed in #18127. Easily fixed by adding a case for `(FunTy InvisArg _ _)`. Fixes #18127. - - - - - a95e7fe0 by Ömer Sinan Ağacan at 2020-05-06T04:42:39-04:00 ELF linker: increment curSymbol after filling in fields of current entry The bug was introduced in a8b7cef4d45 which added a field to the `symbols` array elements and then updated this code incorrectly: - oc->symbols[curSymbol++] = nm; + oc->symbols[curSymbol++].name = nm; + oc->symbols[curSymbol].addr = symbol->addr; - - - - - cab1871a by Sylvain Henry at 2020-05-06T04:43:21-04:00 Move LeadingUnderscore into Platform (#17957) Avoid direct use of DynFlags to know if symbols must be prefixed by an underscore. - - - - - 94e7c563 by Sylvain Henry at 2020-05-06T04:43:21-04:00 Don't use DynFlags in showLinkerState (#17957) - - - - - 9afd9251 by Ryan Scott at 2020-05-06T04:43:58-04:00 Refactoring: Use bindSigTyVarsFV in rnMethodBinds `rnMethodBinds` was explicitly using `xoptM` to determine if `ScopedTypeVariables` is enabled before bringing type variables bound by the class/instance header into scope. However, this `xoptM` logic is already performed by the `bindSigTyVarsFV` function. This patch uses `bindSigTyVarsFV` in `rnMethodBinds` to reduce the number of places where we need to consult if `ScopedTypeVariables` is on. This is purely refactoring, and there should be no user-visible change in behavior. - - - - - 6f6d72b2 by Brian Foley at 2020-05-08T15:29:25-04:00 Remove further dead code found by a simple Python script. Avoid removing some functions that are part of an API even though they're not used in-tree at the moment. - - - - - 78bf8bf9 by Julien Debon at 2020-05-08T15:29:28-04:00 Add doc examples for Bifoldable See #17929 - - - - - 66f0a847 by Julien Debon at 2020-05-08T15:29:29-04:00 doc (Bitraversable): Add examples to Bitraversable * Add examples to Data.Bitraversable * Fix formatting for (,) in Bitraversable and Bifoldable * Fix mistake on bimapAccumR documentation See #17929 - - - - - 9749fe12 by Baldur Blöndal at 2020-05-08T15:29:32-04:00 Specify kind variables for inferred kinds in base. - - - - - 4e9aef9e by John Ericson at 2020-05-08T15:29:36-04:00 HsSigWcTypeScoping: Pull in documentation from stray location - - - - - f4d5c6df by John Ericson at 2020-05-08T15:29:36-04:00 Rename local `real_fvs` to `implicit_vs` It doesn't make sense to call the "free" variables we are about to implicitly bind the real ones. - - - - - 20570b4b by John Ericson at 2020-05-08T15:29:36-04:00 A few tiny style nits with renaming - Use case rather than guards that repeatedly scrutenize same thing. - No need for view pattern when `L` is fine. - Use type synnonym to convey the intent like elsewhere. - - - - - 09ac8de5 by John Ericson at 2020-05-08T15:29:36-04:00 Add `forAllOrNothing` function with note - - - - - bb35c0e5 by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Document lawlessness of Ap's Num instance - - - - - cdd229ff by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply suggestion to libraries/base/Data/Monoid.hs - - - - - 926d2aab by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply more suggestions from Simon Jakobi - - - - - 7a763cff by Adam Gundry at 2020-05-08T15:29:41-04:00 Reject all duplicate declarations involving DuplicateRecordFields (fixes #17965) This fixes a bug that resulted in some programs being accepted that used the same identifier as a field label and another declaration, depending on the order they appeared in the source code. - - - - - 88e3c815 by Simon Peyton Jones at 2020-05-08T15:29:41-04:00 Fix specialisation for DFuns When specialising a DFun we must take care to saturate the unfolding. See Note [Specialising DFuns] in Specialise. Fixes #18120 - - - - - 86c77b36 by Greg Steuck at 2020-05-08T15:29:45-04:00 Remove unused SEGMENT_PROT_RWX It's been unused for a year and is problematic on any OS which requires W^X for security. - - - - - 9d97f4b5 by nineonine at 2020-05-08T15:30:03-04:00 Add test for #16167 - - - - - aa318338 by Ryan Scott at 2020-05-08T15:30:04-04:00 Bump exceptions submodule so that dist-boot is .gitignore'd `exceptions` is a stage-0 boot library as of commit 30272412fa437ab8e7a8035db94a278e10513413, which means that building `exceptions` in a GHC tree will generate a `dist-boot` directory. However, this directory was not specified in `exceptions`' `.gitignore` file, which causes it to dirty up the current `git` working directory. Accordingly, this bumps the `exceptions` submodule to commit ghc/packages/exceptions at 23c0b8a50d7592af37ca09beeec16b93080df98f, which adds `dist-boot` to the `.gitignore` file. - - - - - ea86360f by Ömer Sinan Ağacan at 2020-05-08T15:30:30-04:00 Linker.c: initialize n_symbols of ObjectCode with other fields - - - - - 951c1fb0 by Sylvain Henry at 2020-05-09T21:46:38-04:00 Fix unboxed-sums GC ptr-slot rubbish value (#17791) This patch allows boot libraries to use unboxed sums without implicitly depending on `base` package because of `absentSumFieldError`. See updated Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make - - - - - b352d63c by Ben Gamari at 2020-05-09T21:47:14-04:00 rts: Make non-existent linker search path merely a warning As noted in #18105, previously this resulted in a rather intrusive error message. This is in contrast to the general expectation that search paths are merely places to look, not places that must exist. Fixes #18105. - - - - - cf4f1e2f by Ben Gamari at 2020-05-13T02:02:33-04:00 rts/CNF: Fix fixup comparison function Previously we would implicitly convert the difference between two words to an int, resulting in an integer overflow on 64-bit machines. Fixes #16992 - - - - - a03da9bf by Ömer Sinan Ağacan at 2020-05-13T02:03:16-04:00 Pack some of IdInfo fields into a bit field This reduces residency of compiler quite a bit on some programs. Example stats when building T10370: Before: 2,871,242,832 bytes allocated in the heap 4,693,328,008 bytes copied during GC 33,941,448 bytes maximum residency (276 sample(s)) 375,976 bytes maximum slop 83 MiB total memory in use (0 MB lost due to fragmentation) After: 2,858,897,344 bytes allocated in the heap 4,629,255,440 bytes copied during GC 32,616,624 bytes maximum residency (278 sample(s)) 314,400 bytes maximum slop 80 MiB total memory in use (0 MB lost due to fragmentation) So -3.9% residency, -1.3% bytes copied and -0.4% allocations. Fixes #17497 Metric Decrease: T9233 T9675 - - - - - 670c3e5c by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Fix base URL Revert a change previously made for testing purposes. - - - - - 8ad8dc41 by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Improve diagnostics output - - - - - 8c0740b7 by Simon Jakobi at 2020-05-13T02:04:33-04:00 docs: Add examples for Data.Semigroup.Arg{Min,Max} Context: #17153 - - - - - cb22348f by Ben Gamari at 2020-05-13T02:05:11-04:00 Add few cleanups of the CAF logic Give the NameSet of non-CAFfy names a proper newtype to distinguish it from all of the other NameSets floating about. - - - - - 90e38b81 by Emeka Nkurumeh at 2020-05-13T02:05:51-04:00 fix printf warning when using with ghc with clang on mingw - - - - - 86d8ac22 by Sebastian Graf at 2020-05-13T02:06:29-04:00 CprAnal: Don't attach CPR sigs to expandable bindings (#18154) Instead, look through expandable unfoldings in `cprTransform`. See the new Note [CPR for expandable unfoldings]: ``` Long static data structures (whether top-level or not) like xs = x1 : xs1 xs1 = x2 : xs2 xs2 = x3 : xs3 should not get CPR signatures, because they * Never get WW'd, so their CPR signature should be irrelevant after analysis (in fact the signature might even be harmful for that reason) * Would need to be inlined/expanded to see their constructed product * Recording CPR on them blows up interface file sizes and is redundant with their unfolding. In case of Nested CPR, this blow-up can be quadratic! But we can't just stop giving DataCon application bindings the CPR property, for example fac 0 = 1 fac n = n * fac (n-1) fac certainly has the CPR property and should be WW'd! But FloatOut will transform the first clause to lvl = 1 fac 0 = lvl If lvl doesn't have the CPR property, fac won't either. But lvl doesn't have a CPR signature to extrapolate into a CPR transformer ('cprTransform'). So instead we keep on cprAnal'ing through *expandable* unfoldings for these arity 0 bindings via 'cprExpandUnfolding_maybe'. In practice, GHC generates a lot of (nested) TyCon and KindRep bindings, one for each data declaration. It's wasteful to attach CPR signatures to each of them (and intractable in case of Nested CPR). ``` Fixes #18154. - - - - - e34bf656 by Ben Gamari at 2020-05-13T02:07:08-04:00 users-guide: Add discussion of shared object naming Fixes #18074. - - - - - 5d0f2445 by Ben Gamari at 2020-05-13T02:07:47-04:00 testsuite: Print sign of performance changes Executes the minor formatting change in the tabulated performance changes suggested in #18135. - - - - - 9e4b981f by Ben Gamari at 2020-05-13T02:08:24-04:00 testsuite: Add testcase for #18129 - - - - - 266310c3 by Ivan-Yudin at 2020-05-13T02:09:03-04:00 doc: Reformulate the opening paragraph of Ch. 4 in User's guide Removes mentioning of Hugs (it is not helpful for new users anymore). Changes the wording for the rest of the paragraph. Fixes #18132. - - - - - 55e35c0b by Baldur Blöndal at 2020-05-13T20:02:48-04:00 Predicate, Equivalence derive via `.. -> a -> All' - - - - - d7e0b57f by Alp Mestanogullari at 2020-05-13T20:03:30-04:00 hadrian: add a --freeze2 option to freeze stage 1 and 2 - - - - - d880d6b2 by Artem Pelenitsyn at 2020-05-13T20:04:11-04:00 Don't reload environment files on every setSessionDynFlags Makes `interpretPackageEnv` (which loads envirinment files) a part of `parseDynamicFlags` (parsing command-line arguments, which is typically done once) instead of `setSessionDynFlags` (which is typically called several times). Making several (transitive) calls to `interpretPackageEnv`, as before, caused #18125 #16318, which should be fixed now. - - - - - 102cfd67 by Ryan Scott at 2020-05-13T20:04:46-04:00 Factor out HsPatSigType for pat sigs/RULE term sigs (#16762) This implements chunks (2) and (3) of https://gitlab.haskell.org/ghc/ghc/issues/16762#note_270170. Namely, it introduces a dedicated `HsPatSigType` AST type, which represents the types that can appear in pattern signatures and term-level `RULE` binders. Previously, these were represented with `LHsSigWcType`. Although `LHsSigWcType` is isomorphic to `HsPatSigType`, the intended semantics of the two types are slightly different, as evidenced by the fact that they have different code paths in the renamer and typechecker. See also the new `Note [Pattern signature binders and scoping]` in `GHC.Hs.Types`. - - - - - b17574f7 by Hécate at 2020-05-13T20:05:28-04:00 fix(documentation): Fix the RST links to GHC.Prim - - - - - df021fb1 by Baldur Blöndal at 2020-05-13T20:06:06-04:00 Document (->) using inferred quantification for its runtime representations. Fixes #18142. - - - - - 1a93ea57 by Takenobu Tani at 2020-05-13T20:06:54-04:00 Tweak man page for ghc command This commit updates the ghc command's man page as followings: * Enable `man_show_urls` to show URL addresses in the `DESCRIPTION` section of ghc.rst, because sphinx currently removes hyperlinks for man pages. * Add a `SEE ALSO` section to point to the GHC homepage - - - - - a951e1ba by Takenobu Tani at 2020-05-13T20:07:37-04:00 GHCi: Add link to the user's guide in help message This commit adds a link to the user's guide in ghci's `:help` message. Newcomers could easily reach to details of ghci. - - - - - 404581ea by Jeff Happily at 2020-05-13T20:08:15-04:00 Handle single unused import - - - - - 1c999e5d by Ben Gamari at 2020-05-13T20:09:07-04:00 Ensure that printMinimalImports closes handle Fixes #18166. - - - - - c9f5a8f4 by Ben Gamari at 2020-05-13T20:09:51-04:00 hadrian: Tell testsuite driver about LLVM availability This reflects the logic present in the Make build system into Hadrian. Fixes #18167. - - - - - c05c0659 by Simon Jakobi at 2020-05-14T03:31:21-04:00 Improve some folds over Uniq[D]FM * Replace some non-deterministic lazy folds with strict folds. * Replace some O(n log n) folds in deterministic order with O(n) non-deterministic folds. * Replace some folds with set-operations on the underlying IntMaps. This reduces max residency when compiling `nofib/spectral/simple/Main.hs` with -O0 by about 1%. Maximum residency when compiling Cabal also seems reduced on the order of 3-9%. - - - - - 477f13bb by Simon Jakobi at 2020-05-14T03:31:58-04:00 Use Data.IntMap.disjoint Data.IntMap gained a dedicated `disjoint` function in containers-0.6.2.1. This patch applies this function where appropriate in hopes of modest compiler performance improvements. Closes #16806. - - - - - e9c0110c by Ben Gamari at 2020-05-14T12:25:53-04:00 IdInfo: Add reference to bitfield-packing ticket - - - - - 9bd20e83 by Sebastian Graf at 2020-05-15T10:42:09-04:00 DmdAnal: Improve handling of precise exceptions This patch does two things: Fix possible unsoundness in what was called the "IO hack" and implement part 2.1 of the "fixing precise exceptions" plan in https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions, which, in combination with !2956, supersedes !3014 and !2525. **IO hack** The "IO hack" (which is a fallback to preserve precise exceptions semantics and thus soundness, rather than some smart thing that increases precision) is called `exprMayThrowPreciseException` now. I came up with two testcases exemplifying possible unsoundness (if twisted enough) in the old approach: - `T13380d`: Demonstrating unsoundness of the "IO hack" when resorting to manual state token threading and direct use of primops. More details below. - `T13380e`: Demonstrating unsoundness of the "IO hack" when we have Nested CPR. Not currently relevant, as we don't have Nested CPR yet. - `T13380f`: Demonstrating unsoundness of the "IO hack" for safe FFI calls. Basically, the IO hack assumed that precise exceptions can only be thrown from a case scrutinee of type `(# State# RealWorld, _ #)`. I couldn't come up with a program using the `IO` abstraction that violates this assumption. But it's easy to do so via manual state token threading and direct use of primops, see `T13380d`. Also similar code might be generated by Nested CPR in the (hopefully not too) distant future, see `T13380e`. Hence, we now have a more careful test in `forcesRealWorld` that passes `T13380{d,e}` (and will hopefully be robust to Nested CPR). **Precise exceptions** In #13380 and #17676 we saw that we didn't preserve precise exception semantics in demand analysis. We fixed that with minimal changes in !2956, but that was terribly unprincipled. That unprincipledness resulted in a loss of precision, which is tracked by these new test cases: - `T13380b`: Regression in dead code elimination, because !2956 was too syntactic about `raiseIO#` - `T13380c`: No need to apply the "IO hack" when the IO action may not throw a precise exception (and the existing IO hack doesn't detect that) Fixing both issues in !3014 turned out to be too complicated and had the potential to regress in the future. Hence we decided to only fix `T13380b` and augment the `Divergence` lattice with a new middle-layer element, `ExnOrDiv`, which means either `Diverges` (, throws an imprecise exception) or throws a *precise* exception. See the wiki page on Step 2.1 for more implementational details: https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions#dead-code-elimination-for-raiseio-with-isdeadenddiv-introducing-exnordiv-step-21 - - - - - 568d7279 by Ben Gamari at 2020-05-15T10:42:46-04:00 GHC.Cmm.Opt: Handle MO_XX_Conv This MachOp was introduced by 2c959a1894311e59cd2fd469c1967491c1e488f3 but a wildcard match in cmmMachOpFoldM hid the fact that it wasn't handled. Ideally we would eliminate the match but this appears to be a larger task. Fixes #18141. - - - - - 5bcf8606 by Ryan Scott at 2020-05-17T08:46:38-04:00 Remove duplicate Note [When to print foralls] in GHC.Core.TyCo.Ppr There are two different Notes named `[When to print foralls]`. The most up-to-date one is in `GHC.Iface.Type`, but there is a second one in `GHC.Core.TyCo.Ppr`. The latter is less up-to-date, as it was written before GHC switched over to using ifaces to pretty-print types. I decided to just remove the latter and replace it with a reference to the former. [ci skip] - - - - - 55f0e783 by Fumiaki Kinoshita at 2020-05-21T12:10:44-04:00 base: Add Generic instances to various datatypes under GHC.* * GHC.Fingerprint.Types: Fingerprint * GHC.RTS.Flags: GiveGCStats, GCFlags, ConcFlags, DebugFlags, CCFlags, DoHeapProfile, ProfFlags, DoTrace, TraceFlags, TickyFlags, ParFlags and RTSFlags * GHC.Stats: RTSStats and GCStats * GHC.ByteOrder: ByteOrder * GHC.Unicode: GeneralCategory * GHC.Stack.Types: SrcLoc Metric Increase: haddock.base - - - - - a9311cd5 by Gert-Jan Bottu at 2020-05-21T12:11:31-04:00 Explicit Specificity Implementation for Ticket #16393. Explicit specificity allows users to manually create inferred type variables, by marking them with braces. This way, the user determines which variables can be instantiated through visible type application. The additional syntax is included in the parser, allowing users to write braces in type variable binders (type signatures, data constructors etc). This information is passed along through the renamer and verified in the type checker. The AST for type variable binders, data constructors, pattern synonyms, partial signatures and Template Haskell has been updated to include the specificity of type variables. Minor notes: - Bumps haddock submodule - Disables pattern match checking in GHC.Iface.Type with GHC 8.8 - - - - - 24e61aad by Ben Price at 2020-05-21T12:12:17-04:00 Lint should say when it is checking a rule It is rather confusing that when lint finds an error in a rule attached to a binder, it reports the error as in the RHS, not the rule: ... In the RHS of foo We add a clarifying line: ... In the RHS of foo In a rule attached to foo The implication that the rule lives inside the RHS is a bit odd, but this niggle is already present for unfoldings, whose pattern we are following. - - - - - 78c6523c by Ben Gamari at 2020-05-21T12:13:01-04:00 nonmoving: Optimise the write barrier - - - - - 13f6c9d0 by Andreas Klebinger at 2020-05-21T12:13:45-04:00 Refactor linear reg alloc to remember past assignments. When assigning registers we now first try registers we assigned to in the past, instead of picking the "first" one. This is in extremely helpful when dealing with loops for which variables are dead for part of the loop. This is important for patterns like this: foo = arg1 loop: use(foo) ... foo = getVal() goto loop; There we: * assign foo to the register of arg1. * use foo, it's dead after this use as it's overwritten after. * do other things. * look for a register to put foo in. If we pick an arbitrary one it might differ from the register the start of the loop expect's foo to be in. To fix this we simply look for past register assignments for the given variable. If we find one and the register is free we use that register. This reduces the need for fixup blocks which match the register assignment between blocks. In the example above between the end and the head of the loop. This patch also moves branch weight estimation ahead of register allocation and adds a flag to control it (cmm-static-pred). * It means the linear allocator is more likely to assign the hotter code paths first. * If it assign these first we are: + Less likely to spill on the hot path. + Less likely to introduce fixup blocks on the hot path. These two measure combined are surprisingly effective. Based on nofib we get in the mean: * -0.9% instructions executed * -0.1% reads/writes * -0.2% code size. * -0.1% compiler allocations. * -0.9% compile time. * -0.8% runtime. Most of the benefits are simply a result of removing redundant moves and spills. Reduced compiler allocations likely are the result of less code being generated. (The added lookup is mostly non-allocating). - - - - - edc2cc58 by Andreas Klebinger at 2020-05-21T12:14:25-04:00 NCG: Codelayout: Distinguish conditional and other branches. In #18053 we ended up with a suboptimal code layout because the code layout algorithm didn't distinguish between conditional and unconditional control flow. We can completely eliminate unconditional control flow instructions by placing blocks next to each other, not so much for conditionals. In terms of implementation we simply give conditional branches less weight before computing the layout. Fixes #18053 - - - - - b7a6b2f4 by Gleb Popov at 2020-05-21T12:15:26-04:00 gitlab-ci: Set locale to C.UTF-8. - - - - - a8c27cf6 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow spaces in GHCi :script file names This patch updates the user interface of GHCi so that file names passed to the ':script' command may contain spaces escaped with a backslash. For example: :script foo\ bar.script The implementation uses a modified version of 'words' that does not break on escaped spaces. Fixes #18027. - - - - - 82663959 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Add extra tests for GHCi :script syntax checks The syntax for GHCi's ":script" command allows for only a single file name to be passed as an argument. This patch adds a test for the cases in which a file name is missing or multiple file names are passed. Related to #T18027. - - - - - a0b79e1b by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow GHCi :script file names in double quotes This patch updates the user interface of GHCi so that file names passed to the ':script' command can be wrapped in double quotes. For example: :script "foo bar.script" The implementation uses a modified version of 'words' that treats character sequences enclosed in double quotes as single words. Fixes #18027. - - - - - cf566330 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Update documentation for GHCi :script This patch adds the fixes that allow for file names containing spaces to be passed to GHCi's ':script' command to the release notes for 8.12 and expands the user-guide documentation for ':script' by mentioning how such file names can be passed. Related to #18027. - - - - - 0004ccb8 by Tuan Le at 2020-05-21T12:16:46-04:00 llvmGen: Consider Relocatable read-only data as not constantReferences: #18137 - - - - - 964d3ea2 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_pat` - - - - - b797aa42 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_lpat` and `tc_lpats` - - - - - 5108e84a by John Ericson at 2020-05-21T12:17:30-04:00 More judiciously panic in `ts_pat` - - - - - 510e0451 by John Ericson at 2020-05-21T12:17:30-04:00 Put `PatEnv` first in `GHC.Tc.Gen.Pat.Checker` - - - - - cb4231db by John Ericson at 2020-05-21T12:17:30-04:00 Tiny cleaup eta-reduce away a function argument In GHC, not in the code being compiled! - - - - - 6890c38d by John Ericson at 2020-05-21T12:17:30-04:00 Use braces with do in `SplicePat` case for consistency - - - - - 3451584f by buggymcbugfix at 2020-05-21T12:18:06-04:00 Fix spelling mistakes and typos - - - - - b552e531 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Add INLINABLE pragmas to Enum list producers The INLINABLE pragmas ensure that we export stable (unoptimised) unfoldings in the interface file so we can do list fusion at usage sites. Related tickets: #15185, #8763, #18178. - - - - - e7480063 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Piggyback on Enum Word methods for Word64 If we are on a 64 bit platform, we can use the efficient Enum Word methods for the Enum Word64 instance. - - - - - 892b0c41 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Document INLINE(ABLE) pragmas that enable fusion - - - - - 2b363ebb by Richard Eisenberg at 2020-05-21T12:18:45-04:00 MR template should ask for key part - - - - - a95bbd0b by Sebastian Graf at 2020-05-21T12:19:37-04:00 Make `Int`'s `mod` and `rem` strict in their first arguments They used to be strict until 4d2ac2d (9 years ago). It's obviously better to be strict for performance reasons. It also blocks #18067. NoFib results: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- integer -1.1% +0.4% wheel-sieve2 +21.2% +20.7% -------------------------------------------------------------------------------- Min -1.1% -0.0% Max +21.2% +20.7% Geometric Mean +0.2% +0.2% ``` The regression in `wheel-sieve2` is due to reboxing that likely will go away with the resolution of #18067. See !3282 for details. Fixes #18187. - - - - - d3d055b8 by Galen Huntington at 2020-05-21T12:20:18-04:00 Clarify pitfalls of NegativeLiterals; see #18022. - - - - - 1b508a9e by Alexey Kuleshevich at 2020-05-21T12:21:02-04:00 Fix wording in primops documentation to reflect the correct reasoning: * Besides resizing functions, shrinking ones also mutate the size of a mutable array and because of those two `sizeofMutabeByteArray` and `sizeofSmallMutableArray` are now deprecated * Change reference in documentation to the newer functions `getSizeof*` instead of `sizeof*` for shrinking functions * Fix incorrect mention of "byte" instead of "small" - - - - - 4ca0c8a1 by Andreas Klebinger at 2020-05-21T12:21:53-04:00 Don't variable-length encode magic iface constant. We changed to use variable length encodings for many types by default, including Word32. This makes sense for numbers but not when Word32 is meant to represent four bytes. I added a FixedLengthEncoding newtype to Binary who's instances interpret their argument as a collection of bytes instead of a number. We then use this when writing/reading magic numbers to the iface file. I also took the libery to remove the dummy iface field. This fixes #18180. - - - - - a1275081 by Krzysztof Gogolewski at 2020-05-21T12:22:35-04:00 Add a regression test for #11506 The testcase works now. See explanation in https://gitlab.haskell.org/ghc/ghc/issues/11506#note_273202 - - - - - 8a816e5f by Krzysztof Gogolewski at 2020-05-21T12:23:55-04:00 Sort deterministically metric output Previously, we sorted according to the test name and way, but the metrics (max_bytes_used/peak_megabytes_allocated etc.) were appearing in nondeterministic order. - - - - - 566cc73f by Sylvain Henry at 2020-05-21T12:24:45-04:00 Move isDynLinkName into GHC.Types.Name It doesn't belong into GHC.Unit.State - - - - - d830bbc9 by Adam Sandberg Ericsson at 2020-05-23T13:36:20-04:00 docs: fix formatting and add some links [skip ci] - - - - - 49301ad6 by Andrew Martin at 2020-05-23T13:37:01-04:00 Implement cstringLength# and FinalPtr This function and its accompanying rule resolve issue #5218. A future PR to the bytestring library will make the internal Data.ByteString.Internal.unsafePackAddress compute string length with cstringLength#. This will improve the status quo because it is eligible for constant folding. Additionally, introduce a new data constructor to ForeignPtrContents named FinalPtr. This additional data constructor, when used in the IsString instance for ByteString, leads to more Core-to-Core optimization opportunities, fewer runtime allocations, and smaller binaries. Also, this commit re-exports all the functions from GHC.CString (including cstringLength#) in GHC.Exts. It also adds a new test driver. This test driver is used to perform substring matches on Core that is dumped after all the simplifier passes. In this commit, it is used to check that constant folding of cstringLength# works. - - - - - dcd6bdcc by Ben Gamari at 2020-05-23T13:37:48-04:00 simplCore: Ignore ticks in rule templates This fixes #17619, where a tick snuck in to the template of a rule, resulting in a panic during rule matching. The tick in question was introduced via post-inlining, as discussed in `Note [Simplifying rules]`. The solution we decided upon was to simply ignore ticks in the rule template, as discussed in `Note [Tick annotations in RULE matching]`. Fixes #18162. Fixes #17619. - - - - - 82cb8913 by John Ericson at 2020-05-23T13:38:32-04:00 Fix #18145 and also avoid needless work with implicit vars - `forAllOrNothing` now is monadic, so we can trace whether we bind an explicit `forall` or not. - #18145 arose because the free vars calculation was needlessly complex. It is now greatly simplified. - Replaced some other implicit var code with `filterFreeVarsToBind`. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - a60dc835 by Ben Gamari at 2020-05-23T13:39:12-04:00 Bump process submodule Fixes #17926. - - - - - 856adf54 by Ben Gamari at 2020-05-23T13:40:21-04:00 users-guide: Clarify meaning of -haddock flag Fixes #18206. - - - - - 7ae57afd by Ben Gamari at 2020-05-23T13:41:03-04:00 git: Add ignored commits file This can be used to tell git to ignore bulk renaming commits like the recently-finished module hierarchy refactoring. Configured with, git config blame.ignoreRevsFile .git-ignore-revs - - - - - 63d30e60 by jneira at 2020-05-24T01:54:42-04:00 Add hie-bios script for windows systems It is a direct translation of the sh script - - - - - 59182b88 by jneira at 2020-05-24T01:54:42-04:00 Honour previous values for CABAL and CABFLAGS The immediate goal is let the hie-bios.bat script set CABFLAGS with `-v0` and remove all cabal output except the compiler arguments - - - - - 932dc54e by jneira at 2020-05-24T01:54:42-04:00 Add specific configuration for windows in hie.yaml - - - - - e0eda070 by jneira at 2020-05-24T01:54:42-04:00 Remove not needed hie-bios output - - - - - a0ea59d6 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Move Config module into GHC.Settings - - - - - 37430251 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Core.Arity into GHC.Core.Opt.Arity - - - - - a426abb9 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Hs.Types into GHC.Hs.Type See discussion in https://gitlab.haskell.org/ghc/ghc/issues/13009#note_268610 - - - - - 1c91a7a0 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Bump haddock submodule - - - - - 66bd24d1 by Ryan Scott at 2020-05-24T01:56:03-04:00 Add orderingTyCon to wiredInTyCons (#18185) `Ordering` needs to be wired in for use in the built-in `CmpNat` and `CmpSymbol` type families, but somehow it was never added to the list of `wiredInTyCons`, leading to the various oddities observed in #18185. Easily fixed by moving `orderingTyCon` from `basicKnownKeyNames` to `wiredInTyCons`. Fixes #18185. - - - - - 01c43634 by Matthew Pickering at 2020-05-24T01:56:42-04:00 Remove unused hs-boot file - - - - - 7a07aa71 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix cross-compiler build (#16051) - - - - - 15ccca16 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix distDir per stage - - - - - b420fb24 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix hp2ps error during cross-compilation Fixed by @alp (see https://gitlab.haskell.org/ghc/ghc/issues/16051#note_274265) - - - - - cd339ef0 by Joshua Price at 2020-05-24T15:22:56-04:00 Make Unicode brackets opening/closing tokens (#18225) The tokens `[|`, `|]`, `(|`, and `|)` are opening/closing tokens as described in GHC Proposal #229. This commit makes the unicode variants (`⟦`, `⟧`, `⦇`, and `⦈`) act the same as their ASCII counterparts. - - - - - 013d7120 by Ben Gamari at 2020-05-25T09:48:17-04:00 Revert "Specify kind variables for inferred kinds in base." As noted in !3132, this has rather severe knock-on consequences in user-code. We'll need to revisit this before merging something along these lines. This reverts commit 9749fe1223d182b1f8e7e4f7378df661c509f396. - - - - - 4c4312ed by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Drop redundant ad-hoc boot module check To determine whether the module is a boot module Coverage.addTicksToBinds was checking for a `boot` suffix in the module source filename. This is quite ad-hoc and shouldn't be necessary; the callsite in `deSugar` already checks that the module isn't a boot module. - - - - - 1abf3c84 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make tickBoxCount strict This could otherwise easily cause a leak of (+) thunks. - - - - - b2813750 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make ccIndices strict This just seems like a good idea. - - - - - 02e278eb by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Don't produce ModBreaks if not HscInterpreted emptyModBreaks contains a bottom and consequently it's important that we don't use it unless necessary. - - - - - b8c014ce by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Factor out addMixEntry - - - - - 53814a64 by Zubin Duggal at 2020-05-26T03:03:24-04:00 Add info about typeclass evidence to .hie files See `testsuite/tests/hiefile/should_run/HieQueries.hs` and `testsuite/tests/hiefile/should_run/HieQueries.stdout` for an example of this We add two new fields, `EvidenceVarBind` and `EvidenceVarUse` to the `ContextInfo` associated with an Identifier. These are associated with the appropriate identifiers for the evidence variables collected when we come across `HsWrappers`, `TcEvBinds` and `IPBinds` while traversing the AST. Instance dictionary and superclass selector dictionaries from `tcg_insts` and classes defined in `tcg_tcs` are also recorded in the AST as originating from their definition span This allows us to save a complete picture of the evidence constructed by the constraint solver, and will let us report this to the user, enabling features like going to the instance definition from the invocation of a class method(or any other method taking a constraint) and finding all usages of a particular instance. Additionally, - Mark NodeInfo with an origin so we can differentiate between bindings origininating in the source vs those in ghc - Along with typeclass evidence info, also include information on Implicit Parameters - Add a few utility functions to HieUtils in order to query the new info Updates haddock submodule - - - - - 6604906c by Sebastian Graf at 2020-05-26T03:04:04-04:00 Make WorkWrap.Lib.isWorkerSmallEnough aware of the old arity We should allow a wrapper with up to 82 parameters when the original function had 82 parameters to begin with. I verified that this made no difference on NoFib, but then again it doesn't use huge records... Fixes #18122. - - - - - cf772f19 by Sylvain Henry at 2020-05-26T03:04:45-04:00 Enhance Note [About units] for Backpack - - - - - ede24126 by Takenobu Tani at 2020-05-27T00:13:55-04:00 core-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Core.hs <= coreSyn/CoreSyn.hs * GHC/Core/Coercion.hs <= types/Coercion.hs * GHC/Core/Coercion/Axiom.hs <= types/CoAxiom.hs * GHC/Core/Coercion/Opt.hs <= types/OptCoercion.hs * GHC/Core/DataCon.hs <= basicTypes/DataCon.hs * GHC/Core/FamInstEnv.hs <= types/FamInstEnv.hs * GHC/Core/Lint.hs <= coreSyn/CoreLint.hs * GHC/Core/Subst.hs <= coreSyn/CoreSubst.hs * GHC/Core/TyCo/Rep.hs <= types/TyCoRep.hs * GHC/Core/TyCon.hs <= types/TyCon.hs * GHC/Core/Type.hs <= types/Type.hs * GHC/Core/Unify.hs <= types/Unify.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/Var.hs <= basicTypes/Var.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [skip ci] - - - - - 04750304 by Ben Gamari at 2020-05-27T00:14:33-04:00 eventlog: Fix racy flushing Previously no attempt was made to avoid multiple threads writing their capability-local eventlog buffers to the eventlog writer simultaneously. This could result in multiple eventlog streams being interleaved. Fix this by documenting that the EventLogWriter's write() and flush() functions may be called reentrantly and fix the default writer to protect its FILE* by a mutex. Fixes #18210. - - - - - d6203f24 by Joshua Price at 2020-05-27T00:15:17-04:00 Make `identifier` parse unparenthesized `->` (#18060) - - - - - 28deee28 by Ben Gamari at 2020-05-28T16:23:21-04:00 GHC.Core.Unfold: Refactor traceInline This reduces duplication as well as fixes a bug wherein -dinlining-check would override -ddump-inlinings. Moreover, the new variant - - - - - 1f393e1e by Ben Gamari at 2020-05-28T16:23:21-04:00 Avoid unnecessary allocations due to tracing utilities While ticky-profiling the typechecker I noticed that hundreds of millions of SDocs are being allocated just in case -ddump-*-trace is enabled. This is awful. We avoid this by ensuring that the dump flag check is inlined into the call site, ensuring that the tracing document needn't be allocated unless it's actually needed. See Note [INLINE conditional tracing utilities] for details. Fixes #18168. Metric Decrease: T9961 haddock.Cabal haddock.base haddock.compiler - - - - - 5f621a78 by Vladislav Zavialov at 2020-05-28T16:23:58-04:00 Add Semigroup/Monoid for Q (#18123) - - - - - dc5f004c by Xavier Denis at 2020-05-28T16:24:37-04:00 Fix #18071 Run the core linter on candidate instances to ensure they are well-kinded. Better handle quantified constraints by using a CtWanted to avoid having unsolved constraints thrown away at the end by the solver. - - - - - 10e6982c by Sebastian Graf at 2020-05-28T16:25:14-04:00 FloatOut: Only eta-expand dead-end RHS if arity will increase (#18231) Otherwise we risk turning trivial RHS into non-trivial RHS, introducing unnecessary bindings in the next Simplifier run, resulting in more churn. Fixes #18231. - - - - - 08dab5f7 by Sebastian Graf at 2020-05-28T16:25:14-04:00 DmdAnal: Recognise precise exceptions from case alternatives (#18086) Consider ```hs m :: IO () m = do putStrLn "foo" error "bar" ``` `m` (from #18086) always throws a (precise or imprecise) exception or diverges. Yet demand analysis infers `<L,A>` as demand signature instead of `<L,A>x` for it. That's because the demand analyser sees `putStrLn` occuring in a case scrutinee and decides that it has to `deferAfterPreciseException`, because `putStrLn` throws a precise exception on some control flow paths. This will mask the `botDiv` `Divergence`of the single case alt containing `error` to `topDiv`. Since `putStrLn` has `topDiv` itself, the final `Divergence` is `topDiv`. This is easily fixed: `deferAfterPreciseException` works by `lub`ing with the demand type of a virtual case branch denoting the precise exceptional control flow. We used `nopDmdType` before, but we can be more precise and use `exnDmdType`, which is `nopDmdType` with `exnDiv`. Now the `Divergence` from the case alt will degrade `botDiv` to `exnDiv` instead of `topDiv`, which combines with the result from the scrutinee to `exnDiv`, and all is well. Fixes #18086. - - - - - aef95f11 by Ben Gamari at 2020-05-28T16:25:53-04:00 Ticky-ticky: Record DataCon name in ticker name This makes it significantly easier to spot the nature of allocations regressions and comes at a reasonably low cost. - - - - - 8f021b8c by Ben Gamari at 2020-05-28T16:26:34-04:00 hadrian: Don't track GHC's verbosity argument Teach hadrian to ignore GHC's -v argument in its recompilation check, thus fixing #18131. - - - - - 13d9380b by Ben Gamari at 2020-05-28T16:27:20-04:00 Rip out CmmStackInfo(updfr_space) As noted in #18232, this field is currently completely unused and moreover doesn't have a clear meaning. - - - - - f10d11fa by Andreas Klebinger at 2020-05-29T01:38:42-04:00 Fix "build/elem" RULE. An redundant constraint prevented the rule from matching. Fixing this allows a call to elem on a known list to be translated into a series of equality checks, and eventually a simple case expression. Surprisingly this seems to regress elem for strings. To avoid this we now also allow foldrCString to inline and add an UTF8 variant. This results in elem being compiled to a tight non-allocating loop over the primitive string literal which performs a linear search. In the process this commit adds UTF8 variants for some of the functions in GHC.CString. This is required to make this work for both ASCII and UTF8 strings. There are also small tweaks to the CString related rules. We now allow ourselfes the luxury to compare the folding function via eqExpr, which helps to ensure the rule fires before we inline foldrCString*. Together with a few changes to allow matching on both the UTF8 and ASCII variants of the CString functions. - - - - - bbeb2389 by Ben Gamari at 2020-05-29T01:39:19-04:00 CoreToStg: Add Outputable ArgInfo instance - - - - - 0e3361ca by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Make Lint check return type of a join point Consider join x = rhs in body It's important that the type of 'rhs' is the same as the type of 'body', but Lint wasn't checking that invariant. Now it does! This was exposed by investigation into !3113. - - - - - c49f7df0 by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Do not float join points in exprIsConApp_maybe We hvae been making exprIsConApp_maybe cleverer in recent times: commit b78cc64e923716ac0512c299f42d4d0012306c05 Date: Thu Nov 15 17:14:31 2018 +0100 Make constructor wrappers inline only during the final phase commit 7833cf407d1f608bebb1d38bb99d3035d8d735e6 Date: Thu Jan 24 17:58:50 2019 +0100 Look through newtype wrappers (Trac #16254) commit c25b135ff5b9c69a90df0ccf51b04952c2dc6ee1 Date: Thu Feb 21 12:03:22 2019 +0000 Fix exprIsConApp_maybe But alas there was still a bug, now immortalised in Note [Don't float join points] in SimpleOpt. It's quite hard to trigger because it requires a dead join point, but it came up when compiling Cabal Cabal.Distribution.Fields.Lexer.hs, when working on !3113. Happily, the fix is extremly easy. Finding the bug was not so easy. - - - - - 46720997 by Ben Gamari at 2020-05-29T01:39:19-04:00 Allow simplification through runRW# Because runRW# inlines so late, we were previously able to do very little simplification across it. For instance, given even a simple program like case runRW# (\s -> let n = I# 42# in n) of I# n# -> f n# we previously had no way to avoid the allocation of the I#. This patch allows the simplifier to push strict contexts into the continuation of a runRW# application, as explained in in Note [Simplification of runRW#] in GHC.CoreToStg.Prep. Fixes #15127. Metric Increase: T9961 Metric Decrease: ManyConstructors Co-Authored-By: Simon Peyton-Jone <simonpj at microsoft.com> - - - - - 277c2f26 by Ben Gamari at 2020-05-29T01:39:55-04:00 Eta expand un-saturated primops Now since we no longer try to predict CAFfyness we have no need for the solution to #16846. Eta expanding unsaturated primop applications is conceptually simpler, especially in the presence of levity polymorphism. This essentially reverts cac8dc9f51e31e4c0a6cd9bc302f7e1bc7c03beb, as suggested in #18079. Closes #18079. - - - - - f44d7ae0 by Simon Jakobi at 2020-05-29T01:40:34-04:00 base: Scrap deprecation plan for Data.Monoid.{First,Last} See the discussion on the libraries mailing list for context: https://mail.haskell.org/pipermail/libraries/2020-April/030357.html - - - - - 8b494895 by Jeremy Schlatter at 2020-05-29T01:41:12-04:00 Fix typo in documentation - - - - - 998450f4 by Gleb Popov at 2020-05-29T01:41:53-04:00 Always define USE_PTHREAD_FOR_ITIMER for FreeBSD. - - - - - f9a513e0 by Alp Mestanogullari at 2020-05-29T01:42:36-04:00 hadrian: introduce 'install' target Its logic is very simple. It `need`s the `binary-dist-dir` target and runs suitable `configure` and `make install` commands for the user. A new `--prefix` command line argument is introduced to specify where GHC should be installed. - - - - - 67738db1 by Travis Whitaker at 2020-05-29T13:34:48-04:00 Build a threaded stage 1 if the bootstrapping GHC supports it. - - - - - aac19e6c by Peter Trommler at 2020-05-29T13:35:24-04:00 PPC NCG: No per-symbol .section ".toc" directives All position independent symbols are collected during code generation and emitted in one go. Prepending each symbol with a .section ".toc" directive is redundant. This patch drops the per-symbol directives leading to smaller assembler files. Fixes #18250 - - - - - 4413828b by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Teach getNumProcessors to return available processors Previously we would report the number of physical processors, which can be quite wrong in a containerized setting. Now we rather return how many processors are in our affinity mask when possible. I also refactored the code to prefer platform-specific since this will report logical CPUs instead of physical (using `machdep.cpu.thread_count` on Darwin and `cpuset_getaffinity` on FreeBSD). Fixes #14781. - - - - - 1449435c by Ben Gamari at 2020-05-30T06:07:31-04:00 users-guide: Note change in getNumProcessors in users guide - - - - - 3d960169 by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Drop compatibility shims for Windows Vista We can now assume that the thread and processor group interfaces are available. - - - - - 7f8f948c by Peter Trommler at 2020-05-30T06:08:07-04:00 PPC NCG: Fix .size directive on powerpc64 ELF v1 Thanks to Sergei Trofimovich for pointing out the issue. Fixes #18237 - - - - - 7c555b05 by Andreas Klebinger at 2020-05-30T06:08:43-04:00 Optimize GHC.Utils.Monad. Many functions in this module are recursive and as such are marked loop breakers. Which means they are unlikely to get an unfolding. This is *bad*. We always want to specialize them to specific Monads. Which requires a visible unfolding at the use site. I rewrote the recursive ones from: foo f x = ... foo x' ... to foo f x = go x where go x = ... As well as giving some pragmas to make all of them available for specialization. The end result is a reduction of allocations of about -1.4% for nofib/spectral/simple/Main.hs when compiled with `-O`. ------------------------- Metric Decrease: T12425 T14683 T5631 T9233 T9675 T9961 WWRec ------------------------- - - - - - 8b1cb5df by Ben Gamari at 2020-05-30T06:09:20-04:00 Windows: Bump Windows toolchain to 0.2 - - - - - 6947231a by Zubin Duggal at 2020-05-30T06:10:02-04:00 Simplify contexts in GHC.Iface.Ext.Ast - - - - - 2ee4f36c by Daniel Gröber at 2020-06-01T06:32:56-04:00 Cleanup OVERWRITING_CLOSURE logic The code is just more confusing than it needs to be. We don't need to mix the threaded check with the ldv profiling check since ldv's init already checks for this. Hence they can be two separate checks. Taking the sanity checking into account is also cleaner via DebugFlags.sanity. No need for checking the DEBUG define. The ZERO_SLOP_FOR_LDV_PROF and ZERO_SLOP_FOR_SANITY_CHECK definitions the old code had also make things a lot more opaque IMO so I removed those. - - - - - 6159559b by Daniel Gröber at 2020-06-01T06:32:56-04:00 Fix OVERWRITING_CLOSURE assuming closures are not inherently used The new ASSERT in LDV_recordDead() was being tripped up by MVars when removeFromMVarBlockedQueue() calls OVERWRITING_CLOSURE() via OVERWRITE_INFO(). - - - - - 38992085 by Daniel Gröber at 2020-06-01T06:32:56-04:00 Always zero shrunk mutable array slop when profiling When shrinking arrays in the profiling way we currently don't always zero the leftover slop. This means we can't traverse such closures in the heap profiler. The old Note [zeroing slop] and #8402 have some rationale for why this is so but I belive the reasoning doesn't apply to mutable closures. There users already have to ensure multiple threads don't step on each other's toes so zeroing should be safe. - - - - - b0c1f2a6 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for #18151 - - - - - 9a99a178 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for desugaring of PostfixOperators - - - - - 2b89ca5b by Ben Gamari at 2020-06-01T06:33:37-04:00 HsToCore: Eta expand left sections Strangely, the comment next to this code already alluded to the fact that even simply eta-expanding will sacrifice laziness. It's quite unclear how we regressed so far. See #18151. - - - - - d412d7a3 by Kirill Elagin at 2020-06-01T06:34:21-04:00 Winferred-safe-imports: Do not exit with error Currently, when -Winferred-safe-imports is enabled, even when it is not turned into an error, the compiler will still exit with exit code 1 if this warning was emitted. Make sure it is really treated as a warning. - - - - - f945eea5 by Ben Gamari at 2020-06-01T06:34:58-04:00 nonmoving: Optimise log2_ceil - - - - - aab606e4 by Bodigrim at 2020-06-01T06:35:36-04:00 Clarify description of fromListN - - - - - 7e5220e2 by Bodigrim at 2020-06-01T06:35:36-04:00 Apply suggestion to libraries/base/GHC/Exts.hs - - - - - f3fb1ce9 by fendor at 2020-06-01T06:36:18-04:00 Add `isInScope` check to `lintCoercion` Mirrors the behaviour of `lintType`. - - - - - 5ac4d946 by fendor at 2020-06-01T06:36:18-04:00 Lint rhs of IfaceRule - - - - - 1cef6126 by Jeremy Schlatter at 2020-06-01T06:37:00-04:00 Fix wording in documentation The duplicate "orphan instance" phrase here doesn't make sense, and was probably an accident. - - - - - 5aaf08f2 by Takenobu Tani at 2020-06-01T06:37:43-04:00 configure: Modify aclocal.m4 according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * Rename: * compiler/GHC/Parser.hs <= compiler/parser/Parser.hs * compiler/GHC/Parser/Lexer.hs <= compiler/Parser/Lexer.hs * Add: * compiler/GHC/Cmm/Lexer.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular - - - - - 15857ad8 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Don't fail if we can't unlink __symlink_test Afterall, it's possible we were unable to create it due to lack of symlink permission. - - - - - 4a7229ef by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Refactor ghostscript detection Tamar reported that he saw crashes due to unhandled exceptions. - - - - - 2ab37eaf by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/perf_notes: Fix ill-typed assignments - - - - - e45d5b66 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/testutil: Fix bytes/str mismatch - - - - - 7002d0cb by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Work around spurious mypy failure - - - - - 11390e3a by Takenobu Tani at 2020-06-01T06:39:05-04:00 Clean up file paths for new module hierarchy This updates comments only. This patch replaces file references according to new module hierarchy. See also: * https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular * https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 8f2e5732 by Takenobu Tani at 2020-06-01T06:39:05-04:00 Modify file paths to module paths for new module hierarchy This updates comments only. This patch replaces module references according to new module hierarchy [1][2]. For files under the `compiler/` directory, I replace them as module paths instead of file paths. For instance, `GHC.Unit.State` instead of `compiler/GHC/Unit/State.hs` [3]. For current and future haddock's markup, this patch encloses the module name with "" [4]. [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 [3]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3375#note_276613 [4]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#linking-to-modules - - - - - 68b71c4a by Tom Ellis at 2020-06-01T06:39:55-04:00 Rename the singleton tuple GHC.Tuple.Unit to GHC.Tuple.Solo - - - - - 95da76c2 by Sylvain Henry at 2020-06-01T06:40:41-04:00 Hadrian: fix binary-dist target for cross-compilation - - - - - 730fcd54 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for the @-operator Since GHC diverges from the Haskell Report by allowing the user to define (@) as an infix operator, we better give a good error message when the user does so unintentionally. In general, this is rather hard to do, as some failures will be discovered only in the renamer or the type checker: x :: (Integer, Integer) x @ (a, b) = (1, 2) This patch does *not* address this general case. However, it gives much better error messages when the binding is not syntactically valid: pairs xs @ (_:xs') = zip xs xs' Before this patch, the error message was rather puzzling: <interactive>:1:1: error: Parse error in pattern: pairs After this patch, the error message includes a hint: <interactive>:1:1: error: Parse error in pattern: pairs In a function binding for the ‘@’ operator. Perhaps you meant an as-pattern, which must not be surrounded by whitespace - - - - - 0fde5377 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TypeApplications With this patch, we always parse f @t as a type application, thereby producing better error messages. This steals two syntactic forms: * Prefix form of the @-operator in expressions. Since the @-operator is a divergence from the Haskell Report anyway, this is not a major loss. * Prefix form of @-patterns. Since we are stealing loose infix form anyway, might as well sacrifice the prefix form for the sake of much better error messages. - - - - - c68e7e1e by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TemplateHaskellQuotes While [e| |], [t| |], [d| |], and so on, steal syntax from list comprehensions, [| |] and [|| ||] do not steal any syntax. Thus we can improve error messages by always accepting them in the lexer. Turns out the renamer already performs necessary validation. - - - - - 120aedbd by Ben Gamari at 2020-06-01T16:07:02-04:00 gitlab-ci: Disable use of ld.lld on ARMv7 It turns out that lld non-deterministically fails on ARMv7. I suspect this may be due to the a kernel regression as this only started happening when we upgraded to 5.4. Nevertheless, easily avoided by simply sticking with gold. Works around #18280. - - - - - d6279ff0 by Ben Gamari at 2020-06-02T13:03:30-04:00 gitlab-ci: Ensure that workaround for #18280 applies to bindisttest We need to ensure that the `configure` flags working around #18280 are propagated to the bindisttest `configure` as well. - - - - - cb5c31b5 by Ben Gamari at 2020-06-03T17:55:04-04:00 gitlab-ci: Allow ARMv7 job to fail Due to #18298. - - - - - 32a4ae90 by John Ericson at 2020-06-04T04:34:42-04:00 Clean up boot vs non-boot disambiguating types We often have (ModuleName, Bool) or (Module, Bool) pairs for "extended" module names (without or with a unit id) disambiguating boot and normal modules. We think this is important enough across the compiler that it deserves a new nominal product type. We do this with synnoyms and a functor named with a `Gen` prefix, matching other newly created definitions. It was also requested that we keep custom `IsBoot` / `NotBoot` sum type. So we have it too. This means changing many the many bools to use that instead. Updates `haddock` submodule. - - - - - c05756cd by Niklas Hambüchen at 2020-06-04T04:35:24-04:00 docs: Add more details on InterruptibleFFI. Details from https://gitlab.haskell.org/ghc/ghc/issues/8684 and https://github.com/takano-akio/filelock/pull/7#discussion_r280332430 - - - - - 1b975aed by Andrew Martin at 2020-06-04T04:36:03-04:00 Allow finalizeForeignPtr to be called on FinalPtr/PlainPtr. MR 2165 (commit 49301ad6226d9a83d110bee8c419615dd94f5ded) regressed finalizeForeignPtr by throwing exceptions when PlainPtr was encounterd. This regression did not make it into a release of GHC. Here, the original behavior is restored, and FinalPtr is given the same treatment as PlainPtr. - - - - - 2bd3929a by Luke Lau at 2020-06-04T04:36:41-04:00 Fix documentation on type families not being extracted It looks like the location of the Names used for CoAxioms on type families are now located at their type constructors. Previously, Docs.hs thought the Names were located in the RHS, so the RealSrcSpan in the instanceMap and getInstLoc didn't match up. Fixes #18241 - - - - - 6735b9d9 by Ben Gamari at 2020-06-04T04:37:21-04:00 GHC.Hs.Instances: Compile with -O0 This module contains exclusively Data instances, which are going to be slow no matter what we do. Furthermore, they are incredibly slow to compile with optimisation (see #9557). Consequently we compile this with -O0. See #18254. - - - - - c330331a by nineonine at 2020-06-04T04:37:59-04:00 Add test for #17669 - - - - - cab684f0 by Ben Gamari at 2020-06-04T04:38:36-04:00 rts: Add Windows-specific implementation of rtsSleep Previously we would use the POSIX path, which uses `nanosleep`. However, it turns out that `nanosleep` is provided by `libpthread` on Windows. In general we don't want to incur such a dependency. Avoid this by simply using `Sleep` on Windows. Fixes #18272. - - - - - ad44b504 by Ben Gamari at 2020-06-04T04:38:36-04:00 compiler: Disable use of process jobs with process < 1.6.9 Due to #17926. - - - - - 6a4098a4 by Moritz Angermann at 2020-06-04T04:55:51-04:00 [linker] Adds void printLoadedObjects(void); This allows us to dump in-memory object code locations for debugging. Fixup printLoadedObjects prototype - - - - - af5e3a88 by Artem Pelenitsyn at 2020-06-05T03:18:49-04:00 base: fix sign confusion in log1mexp implementation (fix #17125) author: claude (https://gitlab.haskell.org/trac-claude) The correct threshold for log1mexp is -(log 2) with the current specification of log1mexp. This change improves accuracy for large negative inputs. To avoid code duplication, a small helper function is added; it isn't the default implementation in Floating because it needs Ord. This patch does nothing to address that the Haskell specification is different from that in common use in other languages. - - - - - 2b792fac by Simon Peyton Jones at 2020-06-05T09:27:50-04:00 Simple subsumption This patch simplifies GHC to use simple subsumption. Ticket #17775 Implements GHC proposal #287 https://github.com/ghc-proposals/ghc-proposals/blob/master/ proposals/0287-simplify-subsumption.rst All the motivation is described there; I will not repeat it here. The implementation payload: * tcSubType and friends become noticably simpler, because it no longer uses eta-expansion when checking subsumption. * No deeplyInstantiate or deeplySkolemise That in turn means that some tests fail, by design; they can all be fixed by eta expansion. There is a list of such changes below. Implementing the patch led me into a variety of sticky corners, so the patch includes several othe changes, some quite significant: * I made String wired-in, so that "foo" :: String rather than "foo" :: [Char] This improves error messages, and fixes #15679 * The pattern match checker relies on knowing about in-scope equality constraints, andd adds them to the desugarer's environment using addTyCsDs. But the co_fn in a FunBind was missed, and for some reason simple-subsumption ends up with dictionaries there. So I added a call to addTyCsDs. This is really part of #18049. * I moved the ic_telescope field out of Implication and into ForAllSkol instead. This is a nice win; just expresses the code much better. * There was a bug in GHC.Tc.TyCl.Instance.tcDataFamInstHeader. We called checkDataKindSig inside tc_kind_sig, /before/ solveEqualities and zonking. Obviously wrong, easily fixed. * solveLocalEqualitiesX: there was a whole mess in here, around failing fast enough. I discovered a bad latent bug where we could successfully kind-check a type signature, and use it, but have unsolved constraints that could fill in coercion holes in that signature -- aargh. It's all explained in Note [Failure in local type signatures] in GHC.Tc.Solver. Much better now. * I fixed a serious bug in anonymous type holes. IN f :: Int -> (forall a. a -> _) -> Int that "_" should be a unification variable at the /outer/ level; it cannot be instantiated to 'a'. This was plain wrong. New fields mode_lvl and mode_holes in TcTyMode, and auxiliary data type GHC.Tc.Gen.HsType.HoleMode. This fixes #16292, but makes no progress towards the more ambitious #16082 * I got sucked into an enormous refactoring of the reporting of equality errors in GHC.Tc.Errors, especially in mkEqErr1 mkTyVarEqErr misMatchMsg misMatchMsgOrCND In particular, the very tricky mkExpectedActualMsg function is gone. It took me a full day. But the result is far easier to understand. (Still not easy!) This led to various minor improvements in error output, and an enormous number of test-case error wibbles. One particular point: for occurs-check errors I now just say Can't match 'a' against '[a]' rather than using the intimidating language of "occurs check". * Pretty-printing AbsBinds Tests review * Eta expansions T11305: one eta expansion T12082: one eta expansion (undefined) T13585a: one eta expansion T3102: one eta expansion T3692: two eta expansions (tricky) T2239: two eta expansions T16473: one eta determ004: two eta expansions (undefined) annfail06: two eta (undefined) T17923: four eta expansions (a strange program indeed!) tcrun035: one eta expansion * Ambiguity check at higher rank. Now that we have simple subsumption, a type like f :: (forall a. Eq a => Int) -> Int is no longer ambiguous, because we could write g :: (forall a. Eq a => Int) -> Int g = f and it'd typecheck just fine. But f's type is a bit suspicious, and we might want to consider making the ambiguity check do a check on each sub-term. Meanwhile, these tests are accepted, whereas they were previously rejected as ambiguous: T7220a T15438 T10503 T9222 * Some more interesting error message wibbles T13381: Fine: one error (Int ~ Exp Int) rather than two (Int ~ Exp Int, Exp Int ~ Int) T9834: Small change in error (improvement) T10619: Improved T2414: Small change, due to order of unification, fine T2534: A very simple case in which a change of unification order means we get tow unsolved constraints instead of one tc211: bizarre impredicative tests; just accept this for now Updates Cabal and haddock submodules. Metric Increase: T12150 T12234 T5837 haddock.base Metric Decrease: haddock.compiler haddock.Cabal haddock.base Merge note: This appears to break the `UnliftedNewtypesDifficultUnification` test. It has been marked as broken in the interest of merging. (cherry picked from commit 66b7b195cb3dce93ed5078b80bf568efae904cc5) - - - - - 2dff8141 by Ryan Scott at 2020-06-05T14:21:24-04:00 Simplify bindLHsTyVarBndrs and bindHsQTyVars Both `bindLHsTyVarBndrs` and `bindHsQTyVars` take two separate `Maybe` arguments, which I find terribly confusing. Thankfully, it's possible to remove one `Maybe` argument from each of these functions, which this patch accomplishes: * `bindHsQTyVars` takes a `Maybe SDoc` argument, which is `Just` if GHC should warn about any of the quantified type variables going unused. However, every call site uses `Nothing` in practice. This makes sense, since it doesn't really make sense to warn about unused type variables bound by an `LHsQTyVars`. For instance, you wouldn't warn about the `a` in `data Proxy a = Proxy` going unused. As a result, I simply remove this `Maybe SDoc` argument altogether. * `bindLHsTyVarBndrs` also takes a `Maybe SDoc` argument for the same reasons that `bindHsQTyVars` took one. To make things more confusing, however, `bindLHsTyVarBndrs` also takes a separate `HsDocContext` argument, which is pretty-printed (to an `SDoc`) in warnings and error messages. In practice, the `Maybe SDoc` and the `HsDocContext` often contain the same text. See the call sites for `bindLHsTyVarBndrs` in `rnFamInstEqn` and `rnConDecl`, for instance. There are only a handful of call sites where the text differs between the `Maybe SDoc` and `HsDocContext` arguments: * In `rnHsRuleDecl`, where the `Maybe SDoc` says "`In the rule`" and the `HsDocContext` says "`In the transformation rule`". * In `rnHsTyKi`/`rn_ty`, where the `Maybe SDoc` says "`In the type`" but the `HsDocContext` is inhereted from the surrounding context (e.g., if `rnHsTyKi` were called on a top-level type signature, the `HsDocContext` would be "`In the type signature`" instead) In both cases, warnings/error messages arguably _improve_ by unifying making the `Maybe SDoc`'s text match that of the `HsDocContext`. As a result, I decided to remove the `Maybe SDoc` argument to `bindLHsTyVarBndrs` entirely and simply reuse the text from the `HsDocContext`. (I decided to change the phrase "transformation rule" to "rewrite rule" while I was in the area.) The `Maybe SDoc` argument has one other purpose: signaling when to emit "`Unused quantified type variable`" warnings. To recover this functionality, I replaced the `Maybe SDoc` argument with a boolean-like `WarnUnusedForalls` argument. The only `bindLHsTyVarBndrs` call site that chooses _not_ to emit these warnings in `bindHsQTyVars`. - - - - - e372331b by Ben Gamari at 2020-06-07T08:46:41-04:00 hadrian: Add missing deriveConstants dependency on ghcplatform.h deriveConstants wants to compile C sources which #include PosixSource.h, which itself #includes ghcplatform.h. Make sure that Hadrian knows about this dependency. Fixes #18290. - - - - - b022051a by Moritz Angermann at 2020-06-07T08:46:42-04:00 ghc-prim needs to depend on libc and libm libm is just an empty shell on musl, and all the math functions are contained in libc. - - - - - 6dae6548 by Moritz Angermann at 2020-06-07T08:46:42-04:00 Disable DLL loading if without system linker Some platforms (musl, aarch64) do not have a working dynamic linker implemented in the libc, even though we might see dlopen. It will ultimately just return that this is not supported. Hence we'll add a flag to the compiler to flat our disable loading dlls. This is needed as we will otherwise try to load the shared library even if this will subsequently fail. At that point we have given up looking for static options though. - - - - - 4a158ffc by Moritz Angermann at 2020-06-07T08:46:43-04:00 Range is actually +/-2^32, not +/-2^31 See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf - - - - - f1bfb806 by Ben Gamari at 2020-06-07T10:49:30-04:00 OccurAnal: Avoid exponential behavior due to where clauses Previously the `Var` case of `occAnalApp` could in some cases (namely in the case of `runRW#` applications) call `occAnalRhs` two. In the case of nested `runRW#`s this results in exponential complexity. In some cases the compilation time that resulted would be very long indeed (see #18296). Fixes #18296. Metric Decrease: T9961 T12150 T12234 - - - - - 9b607671 by Takenobu Tani at 2020-06-09T08:05:46-04:00 Add link to GHC's wiki in the GHC API header This adds a URL to point to GHC's wiki in the GHC API header. Newcomers could easily find more information from the GHC API's web like [1]. [1]: Current version, https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-8.11.0.20200604/index.html [skip ci] - - - - - 72c7fe9a by Ryan Scott at 2020-06-09T08:06:24-04:00 Make GADT constructors adhere to the forall-or-nothing rule properly Issue #18191 revealed that the types of GADT constructors don't quite adhere to the `forall`-or-nothing rule. This patch serves to clean up this sad state of affairs somewhat. The main change is not in the code itself, but in the documentation, as this patch introduces two sections to the GHC User's Guide: * A "Formal syntax for GADTs" section that presents a BNF-style grammar for what is and isn't allowed in GADT constructor types. This mostly exists to codify GHC's existing behavior, but it also imposes a new restriction that addresses #18191: the outermost `forall` and/or context in a GADT constructor is not allowed to be surrounded by parentheses. Doing so would make these `forall`s/contexts nested, and GADTs do not support nested `forall`s/contexts at present. * A "`forall`-or-nothing rule" section that describes exactly what the `forall`-or-nothing rule is all about. Surprisingly, there was no mention of this anywhere in the User's Guide up until now! To adhere the new specification in the "Formal syntax for GADTs" section of the User's Guide, the following code changes were made: * A new function, `GHC.Hs.Type.splitLHsGADTPrefixTy`, was introduced. This is very much like `splitLHsSigmaTy`, except that it avoids splitting apart any parentheses, which can be syntactically significant for GADT types. See `Note [No nested foralls or contexts in GADT constructors]` in `GHC.Hs.Type`. * `ConDeclGADTPrefixPs`, an extension constructor for `XConDecl`, was introduced so that `GHC.Parser.PostProcess.mkGadtDecl` can return it when given a prefix GADT constructor. Unlike `ConDeclGADT`, `ConDeclGADTPrefixPs` does not split the GADT type into its argument and result types, as this cannot be done until after the type is renamed (see `Note [GADT abstract syntax]` in `GHC.Hs.Decls` for why this is the case). * `GHC.Renamer.Module.rnConDecl` now has an additional case for `ConDeclGADTPrefixPs` that (1) splits apart the full `LHsType` into its `forall`s, context, argument types, and result type, and (2) checks for nested `forall`s/contexts. Step (2) used to be performed the typechecker (in `GHC.Tc.TyCl.badDataConTyCon`) rather than the renamer, but now the relevant code from the typechecker can simply be deleted. One nice side effect of this change is that we are able to give a more accurate error message for GADT constructors that use visible dependent quantification (e.g., `MkFoo :: forall a -> a -> Foo a`), which improves the stderr in the `T16326_Fail6` test case. Fixes #18191. Bumps the Haddock submodule. - - - - - a47e6442 by Ryan Scott at 2020-06-10T03:39:12-04:00 Always use rnImplicitBndrs to bring implicit tyvars into scope This implements a first step towards #16762 by changing the renamer to always use `rnImplicitBndrs` to bring implicitly bound type variables into scope. The main change is in `rnFamInstEqn` and `bindHsQTyVars`, which previously used _ad hoc_ methods of binding their implicit tyvars. There are a number of knock-on consequences: * One of the reasons that `rnFamInstEqn` used an _ad hoc_ binding mechanism was to give more precise source locations in `-Wunused-type-patterns` warnings. (See https://gitlab.haskell.org/ghc/ghc/issues/16762#note_273343 for an example of this.) However, these warnings are actually a little _too_ precise, since implicitly bound type variables don't have exact binding sites like explicitly bound type variables do. A similar problem existed for "`Different names for the same type variable`" errors involving implicit tyvars bound by `bindHsQTyVars`. Therefore, we simply accept the less precise (but more accurate) source locations from `rnImplicitBndrs` in `rnFamInstEqn` and `bindHsQTyVars`. See `Note [Source locations for implicitly bound type variables]` in `GHC.Rename.HsType` for the full story. * In order for `rnImplicitBndrs` to work in `rnFamInstEqn`, it needs to be able to look up names from the parent class (in the event that we are renaming an associated type family instance). As a result, `rnImplicitBndrs` now takes an argument of type `Maybe assoc`, which is `Just` in the event that a type family instance is associated with a class. * Previously, GHC kept track of three type synonyms for free type variables in the renamer: `FreeKiTyVars`, `FreeKiTyVarsDups` (which are allowed to contain duplicates), and `FreeKiTyVarsNoDups` (which contain no duplicates). However, making is a distinction between `-Dups` and `-NoDups` is now pointless, as all code that returns `FreeKiTyVars{,Dups,NoDups}` will eventually end up being passed to `rnImplicitBndrs`, which removes duplicates. As a result, I decided to just get rid of `FreeKiTyVarsDups` and `FreeKiTyVarsNoDups`, leaving only `FreeKiTyVars`. * The `bindLRdrNames` and `deleteBys` functions are now dead code, so I took the liberty of removing them. - - - - - 24879129 by Takenobu Tani at 2020-06-10T03:39:59-04:00 Clarify leaf module names for new module hierarchy This updates comments only. This patch replaces leaf module names according to new module hierarchy [1][2] as followings: * Expand leaf names to easily find the module path: for instance, `Id.hs` to `GHC.Types.Id`. * Modify leaf names according to new module hierarchy: for instance, `Convert.hs` to `GHC.ThToHs`. * Fix typo: for instance, `GHC.Core.TyCo.Rep.hs` to `GHC.Core.TyCo.Rep` See also !3375 [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 92de9e25 by Ömer Sinan Ağacan at 2020-06-10T03:41:07-04:00 rts: Remove unused GET_ENTRY closure macro This macro is not used and got broken in the meantime, as ENTRY_CODE was deleted. - - - - - 87102928 by Ömer Sinan Ağacan at 2020-06-10T03:41:50-04:00 Fix -fkeep-cafs flag name in users guide - - - - - ccd6843d by Shayne Fletcher at 2020-06-10T04:14:57-04:00 Expose impliedGFlags, impledOffGFlags, impliedXFlags - - - - - 7a737e89 by Ömer Sinan Ağacan at 2020-06-10T04:14:58-04:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules This is for optimization purposes: if we know LambdaFormInfo of imported Ids we can generate more efficient calling code, see `getCallMethod`. Exporting (putting them in interface files or in ModDetails) and importing (reading them from interface files) are both optional. We don't assume known LambdaFormInfos anywhere and do not change how we call Ids with unknown LambdaFormInfos. Runtime, allocation, and residency numbers when building Cabal-the-library (commit 0d4ee7ba3): (Log and .hp files are in the MR: !2842) | | GHC HEAD | This patch | Diff | |-----|----------|------------|----------------| | -O0 | 0:35.89 | 0:34.10 | -1.78s, -4.98% | | -O1 | 2:24.01 | 2:23.62 | -0.39s, -0.27% | | -O2 | 2:52.23 | 2:51.35 | -0.88s, -0.51% | | | GHC HEAD | This patch | Diff | |-----|-----------------|-----------------|----------------------------| | -O0 | 54,843,608,416 | 54,878,769,544 | +35,161,128 bytes, +0.06% | | -O1 | 227,136,076,400 | 227,569,045,168 | +432,968,768 bytes, +0.19% | | -O2 | 266,147,063,296 | 266,749,643,440 | +602,580,144 bytes, +0.22% | NOTE: Residency is measured with extra runtime args: `-i0 -h` which effectively turn all GCs into major GCs, and do GC more often. | | GHC HEAD | This patch | Diff | |-----|----------------------------|------------------------------|----------------------------| | -O0 | 410,284,000 (910 samples) | 411,745,008 (906 samples) | +1,461,008 bytes, +0.35% | | -O1 | 928,580,856 (2109 samples) | 943,506,552 (2103 samples) | +14,925,696 bytes, +1.60% | | -O2 | 993,951,352 (2549 samples) | 1,010,156,328 (2545 samples) | +16,204,9760 bytes, +1.63% | NoFib results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS 0.0% 0.0% +0.0% +0.0% +0.0% CSD 0.0% 0.0% 0.0% +0.0% +0.0% FS 0.0% 0.0% +0.0% +0.0% +0.0% S 0.0% 0.0% +0.0% +0.0% +0.0% VS 0.0% 0.0% +0.0% +0.0% +0.0% VSD 0.0% 0.0% +0.0% +0.0% +0.1% VSM 0.0% 0.0% +0.0% +0.0% +0.0% anna 0.0% 0.0% -0.3% -0.8% -0.0% ansi 0.0% 0.0% -0.0% -0.0% 0.0% atom 0.0% 0.0% -0.0% -0.0% 0.0% awards 0.0% 0.0% -0.1% -0.3% 0.0% banner 0.0% 0.0% -0.0% -0.0% -0.0% bernouilli 0.0% 0.0% -0.0% -0.0% -0.0% binary-trees 0.0% 0.0% -0.0% -0.0% +0.0% boyer 0.0% 0.0% -0.0% -0.0% 0.0% boyer2 0.0% 0.0% -0.0% -0.0% 0.0% bspt 0.0% 0.0% -0.0% -0.2% 0.0% cacheprof 0.0% 0.0% -0.1% -0.4% +0.0% calendar 0.0% 0.0% -0.0% -0.0% 0.0% cichelli 0.0% 0.0% -0.9% -2.4% 0.0% circsim 0.0% 0.0% -0.0% -0.0% 0.0% clausify 0.0% 0.0% -0.1% -0.3% 0.0% comp_lab_zift 0.0% 0.0% -0.0% -0.0% +0.0% compress 0.0% 0.0% -0.0% -0.0% -0.0% compress2 0.0% 0.0% -0.0% -0.0% 0.0% constraints 0.0% 0.0% -0.1% -0.2% -0.0% cryptarithm1 0.0% 0.0% -0.0% -0.0% 0.0% cryptarithm2 0.0% 0.0% -1.4% -4.1% -0.0% cse 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 0.0% 0.0% -0.0% -0.0% -0.0% dom-lt 0.0% 0.0% -0.1% -0.2% 0.0% eliza 0.0% 0.0% -0.5% -1.5% 0.0% event 0.0% 0.0% -0.0% -0.0% -0.0% exact-reals 0.0% 0.0% -0.1% -0.3% +0.0% exp3_8 0.0% 0.0% -0.0% -0.0% -0.0% expert 0.0% 0.0% -0.3% -1.0% -0.0% fannkuch-redux 0.0% 0.0% +0.0% +0.0% +0.0% fasta 0.0% 0.0% -0.0% -0.0% +0.0% fem 0.0% 0.0% -0.0% -0.0% 0.0% fft 0.0% 0.0% -0.0% -0.0% 0.0% fft2 0.0% 0.0% -0.0% -0.0% 0.0% fibheaps 0.0% 0.0% -0.0% -0.0% +0.0% fish 0.0% 0.0% 0.0% -0.0% +0.0% fluid 0.0% 0.0% -0.4% -1.2% +0.0% fulsom 0.0% 0.0% -0.0% -0.0% 0.0% gamteb 0.0% 0.0% -0.1% -0.3% 0.0% gcd 0.0% 0.0% -0.0% -0.0% 0.0% gen_regexps 0.0% 0.0% -0.0% -0.0% -0.0% genfft 0.0% 0.0% -0.0% -0.0% 0.0% gg 0.0% 0.0% -0.0% -0.0% +0.0% grep 0.0% 0.0% -0.0% -0.0% -0.0% hidden 0.0% 0.0% -0.1% -0.4% -0.0% hpg 0.0% 0.0% -0.2% -0.5% +0.0% ida 0.0% 0.0% -0.0% -0.0% +0.0% infer 0.0% 0.0% -0.3% -0.8% -0.0% integer 0.0% 0.0% -0.0% -0.0% +0.0% integrate 0.0% 0.0% -0.0% -0.0% 0.0% k-nucleotide 0.0% 0.0% -0.0% -0.0% +0.0% kahan 0.0% 0.0% -0.0% -0.0% +0.0% knights 0.0% 0.0% -2.2% -5.4% 0.0% lambda 0.0% 0.0% -0.6% -1.8% 0.0% last-piece 0.0% 0.0% -0.0% -0.0% 0.0% lcss 0.0% 0.0% -0.0% -0.1% 0.0% life 0.0% 0.0% -0.0% -0.1% 0.0% lift 0.0% 0.0% -0.2% -0.6% +0.0% linear 0.0% 0.0% -0.0% -0.0% -0.0% listcompr 0.0% 0.0% -0.0% -0.0% 0.0% listcopy 0.0% 0.0% -0.0% -0.0% 0.0% maillist 0.0% 0.0% -0.1% -0.3% +0.0% mandel 0.0% 0.0% -0.0% -0.0% 0.0% mandel2 0.0% 0.0% -0.0% -0.0% -0.0% mate +0.0% 0.0% -0.0% -0.0% -0.0% minimax 0.0% 0.0% -0.2% -1.0% 0.0% mkhprog 0.0% 0.0% -0.1% -0.2% -0.0% multiplier 0.0% 0.0% -0.0% -0.0% -0.0% n-body 0.0% 0.0% -0.0% -0.0% +0.0% nucleic2 0.0% 0.0% -0.1% -0.2% 0.0% para 0.0% 0.0% -0.0% -0.0% -0.0% paraffins 0.0% 0.0% -0.0% -0.0% 0.0% parser 0.0% 0.0% -0.2% -0.7% 0.0% parstof 0.0% 0.0% -0.0% -0.0% +0.0% pic 0.0% 0.0% -0.0% -0.0% 0.0% pidigits 0.0% 0.0% +0.0% +0.0% +0.0% power 0.0% 0.0% -0.2% -0.6% +0.0% pretty 0.0% 0.0% -0.0% -0.0% -0.0% primes 0.0% 0.0% -0.0% -0.0% 0.0% primetest 0.0% 0.0% -0.0% -0.0% -0.0% prolog 0.0% 0.0% -0.3% -1.1% 0.0% puzzle 0.0% 0.0% -0.0% -0.0% 0.0% queens 0.0% 0.0% -0.0% -0.0% +0.0% reptile 0.0% 0.0% -0.0% -0.0% 0.0% reverse-complem 0.0% 0.0% -0.0% -0.0% +0.0% rewrite 0.0% 0.0% -0.7% -2.5% -0.0% rfib 0.0% 0.0% -0.0% -0.0% 0.0% rsa 0.0% 0.0% -0.0% -0.0% 0.0% scc 0.0% 0.0% -0.1% -0.2% -0.0% sched 0.0% 0.0% -0.0% -0.0% -0.0% scs 0.0% 0.0% -1.0% -2.6% +0.0% simple 0.0% 0.0% +0.0% -0.0% +0.0% solid 0.0% 0.0% -0.0% -0.0% 0.0% sorting 0.0% 0.0% -0.6% -1.6% 0.0% spectral-norm 0.0% 0.0% +0.0% 0.0% +0.0% sphere 0.0% 0.0% -0.0% -0.0% -0.0% symalg 0.0% 0.0% -0.0% -0.0% +0.0% tak 0.0% 0.0% -0.0% -0.0% 0.0% transform 0.0% 0.0% -0.0% -0.0% 0.0% treejoin 0.0% 0.0% -0.0% -0.0% 0.0% typecheck 0.0% 0.0% -0.0% -0.0% +0.0% veritas +0.0% 0.0% -0.2% -0.4% +0.0% wang 0.0% 0.0% -0.0% -0.0% 0.0% wave4main 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 0.0% 0.0% -0.0% -0.0% +0.0% x2n1 0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min 0.0% 0.0% -2.2% -5.4% -0.0% Max +0.0% 0.0% +0.0% +0.0% +0.1% Geometric Mean -0.0% -0.0% -0.1% -0.3% +0.0% Metric increases micro benchmarks tracked in #17686: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 T9233 Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 3b22b14a by Shayne Fletcher at 2020-06-10T04:15:01-04:00 Give Language a Bounded instance - - - - - 9454511b by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Optimisation in Unique.Supply This patch switches on -fno-state-hack in GHC.Types.Unique.Supply. It turned out that my fixes for #18078 (coercion floating) changed the optimisation pathway for mkSplitUniqSupply in such a way that we had an extra allocation inside the inner loop. Adding -fno-state-hack fixed that -- and indeed the loop in mkSplitUniqSupply is a classic example of the way in which -fno-state-hack can be bad; see #18238. Moreover, the new code is better than the old. They allocate the same, but the old code ends up with a partial application. The net effect is that the test perf/should_run/UniqLoop runs 20% faster! From 2.5s down to 2.0s. The allocation numbers are the same -- but elapsed time falls. Good! The bad thing about this is that it's terribly delicate. But at least it's a good example of such delicacy in action. There is a long Note [Optimising the unique supply] which now explains all this. - - - - - 6d49d5be by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Implement cast worker/wrapper properly The cast worker/wrapper transformation transforms x = e |> co into y = e x = y |> co This is done by the simplifier, but we were being careless about transferring IdInfo from x to y, and about what to do if x is a NOINLNE function. This resulted in a series of bugs: #17673, #18093, #18078. This patch fixes all that: * Main change is in GHC.Core.Opt.Simplify, and the new prepareBinding function, which does this cast worker/wrapper transform. See Note [Cast worker/wrappers]. * There is quite a bit of refactoring around prepareRhs, makeTrivial etc. It's nicer now. * Some wrappers from strictness and cast w/w, notably those for a function with a NOINLINE, should inline very late. There wasn't really a mechanism for that, which was an existing bug really; so I invented a new finalPhase = Phase (-1). It's used for all simplifier runs after the user-visible phase 2,1,0 have run. (No new runs of the simplifier are introduced thereby.) See new Note [Compiler phases] in GHC.Types.Basic; the main changes are in GHC.Core.Opt.Driver * Doing this made me trip over two places where the AnonArgFlag on a FunTy was being lost so we could end up with (Num a -> ty) rather than (Num a => ty) - In coercionLKind/coercionRKind - In contHoleType in the Simplifier I fixed the former by defining mkFunctionType and using it in coercionLKind/RKind. I could have done the same for the latter, but the information is almost to hand. So I fixed the latter by - adding sc_hole_ty to ApplyToVal (like ApplyToTy), - adding as_hole_ty to ValArg (like TyArg) - adding sc_fun_ty to StrictArg Turned out I could then remove ai_type from ArgInfo. This is just moving the deck chairs around, but it worked out nicely. See the new Note [AnonArgFlag] in GHC.Types.Var * When looking at the 'arity decrease' thing (#18093) I discovered that stable unfoldings had a much lower arity than the actual optimised function. That's what led to the arity-decrease message. Simple solution: eta-expand. It's described in Note [Eta-expand stable unfoldings] in GHC.Core.Opt.Simplify * I also discovered that unsafeCoerce wasn't being inlined if the context was boring. So (\x. f (unsafeCoerce x)) would create a thunk -- yikes! I fixed that by making inlineBoringOK a bit cleverer: see Note [Inline unsafeCoerce] in GHC.Core.Unfold. I also found that unsafeCoerceName was unused, so I removed it. I made a test case for #18078, and a very similar one for #17673. The net effect of all this on nofib is very modest, but positive: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna -0.4% -0.1% -3.1% -3.1% 0.0% fannkuch-redux -0.4% -0.3% -0.1% -0.1% 0.0% maillist -0.4% -0.1% -7.8% -1.0% -14.3% primetest -0.4% -15.6% -7.1% -6.6% 0.0% -------------------------------------------------------------------------------- Min -0.9% -15.6% -13.3% -14.2% -14.3% Max -0.3% 0.0% +12.1% +12.4% 0.0% Geometric Mean -0.4% -0.2% -2.3% -2.2% -0.1% All following metric decreases are compile-time allocation decreases between -1% and -3%: Metric Decrease: T5631 T13701 T14697 T15164 - - - - - 32fd37f5 by Luke Lau at 2020-06-10T04:17:22-04:00 Fix lookupGlobalOccRn_maybe sometimes reporting an error In some cases it was possible for lookupGlobalOccRn_maybe to return an error, when it should be returning a Nothing. If it called lookupExactOcc_either when there were no matching GlobalRdrElts in the otherwise case, it would return an error message. This could be caused when lookupThName_maybe in Template Haskell was looking in different namespaces (thRdrNameGuesses), guessing different namespaces that the name wasn't guaranteed to be found in. However, by addressing this some more accurate errors were being lost in the conversion to Maybes. So some of the lookup* functions have been shuffled about so that errors should always be ignored in lookup*_maybes, and propagated otherwise. This fixes #18263 - - - - - 9b283e1b by Roland Senn at 2020-06-10T04:17:34-04:00 Initialize the allocation counter in GHCi to 0 (Fixes #16012) According to the documentation for the function `getAllocationCounter` in [System.Mem](http://hackage.haskell.org/package/base-4.14.0.0/docs/System-Mem.html) initialize the allocationCounter also in GHCi to 0. - - - - - 8d07c48c by Sylvain Henry at 2020-06-10T04:17:36-04:00 test: fix conc038 We had spurious failures of conc038 test on CI with stdout: ``` newThread started -mainThread -Haskell: 2 newThread back again +mainThread 1 sec later shutting down +Haskell: 2 ``` - - - - - 4c7e9689 by Sebastian Graf at 2020-06-11T10:37:38+02:00 Release Notes: Add news from the pattern-match checker [skip ci] - - - - - 3445b965 by Sylvain Henry at 2020-06-13T02:13:01-04:00 Only test T16190 with the NCG T16190 is meant to test a NCG feature. It has already caused spurious failures in other MRs (e.g. !2165) when LLVM is used. - - - - - 2517a51c by Sylvain Henry at 2020-06-13T02:13:01-04:00 DynFlags refactoring VIII (#17957) * Remove several uses of `sdocWithDynFlags`, especially in GHC.Llvm.* * Add LlvmOpts datatype to store Llvm backend options * Remove Outputable instances (for LlvmVar, LlvmLit, LlvmStatic and Llvm.MetaExpr) which require LlvmOpts. * Rename ppMetaExpr into ppMetaAnnotExpr (pprMetaExpr is now used in place of `ppr :: MetaExpr -> SDoc`) - - - - - 7a02599a by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove unused code - - - - - 72d08610 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor homeUnit * rename thisPackage into homeUnit * document and refactor several Backpack things - - - - - 8dc71f55 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Rename unsafeGetUnitInfo into unsafeLookupUnit - - - - - f6be6e43 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Add allowVirtualUnits field in PackageState Instead of always querying DynFlags to know whether we are allowed to use virtual units (i.e. instantiated on-the-fly, cf Note [About units] in GHC.Unit), we store it once for all in `PackageState.allowVirtualUnits`. This avoids using DynFlags too much (cf #17957) and is preliminary work for #14335. - - - - - e7272d53 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Enhance UnitId use * use UnitId instead of String to identify wired-in units * use UnitId instead of Unit in the backend (Unit are only use by Backpack to produce type-checked interfaces, not real code) * rename lookup functions for consistency * documentation - - - - - 9c5572cd by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove LinkerUnitId type alias - - - - - d345edfe by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor WiredMap * Remove WiredInUnitId and WiredUnitId type aliases - - - - - 3d171cd6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document and refactor `mkUnit` and `mkUnitInfoMap` - - - - - d2109b4f by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove PreloadUnitId type alias - - - - - f50c19b8 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename listUnitInfoMap into listUnitInfo There is no Map involved - - - - - ed533ec2 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit The terminology changed over time and now package databases contain "units" (there can be several units compiled from a single Cabal package: one per-component, one for each option set, one per instantiation, etc.). We should try to be consistent internally and use "units": that's what this renaming does. Maybe one day we'll fix the UI too (e.g. replace -package-id with -unit-id, we already have -this-unit-id and ghc-pkg has -unit-id...) but it's not done in this patch. * rename getPkgFrameworkOpts into getUnitFrameworkOpts * rename UnitInfoMap into ClosureUnitInfoMap * rename InstalledPackageIndex into UnitInfoMap * rename UnusablePackages into UnusableUnits * rename PackagePrecedenceIndex into UnitPrecedenceMap * rename PackageDatabase into UnitDatabase * rename pkgDatabase into unitDatabases * rename pkgState into unitState * rename initPackages into initUnits * rename renamePackage into renameUnitInfo * rename UnusablePackageReason into UnusableUnitReason * rename getPackage* into getUnit* * etc. - - - - - 202728e5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Make ClosureUnitInfoMap uses UnitInfoMap - - - - - 55b4263e by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove ClosureUnitInfoMap - - - - - 653d17bd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit (2) * rename PackageState into UnitState * rename findWiredInPackages into findWiredInUnits * rename lookupModuleInAll[Packages,Units] * etc. - - - - - ae900605 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move dump_mod_map into initUnits - - - - - 598cc1dd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move wiring of homeUnitInstantiations outside of mkUnitState - - - - - 437265eb by Sylvain Henry at 2020-06-13T02:13:03-04:00 Avoid timing module map dump in initUnits - - - - - 9400aa93 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove preload parameter of mkUnitState * Remove preload parameter (unused) * Don't explicitly return preloaded units: redundant because already returned as "preloadUnits" field of UnitState - - - - - 266bc3d9 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: refactor unwireUnit - - - - - 9e715c1b by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document getPreloadUnitsAnd - - - - - bd5810dc by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: remove useless add_package parameter - - - - - 36e1daf0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: make listVisibleModuleNames take a UnitState - - - - - 5226da37 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document add_package - - - - - 4b53aac1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document closeUnitDeps - - - - - 42c054f6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: findWiredInUnits - - - - - a444d01b by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: reportCycles, reportUnusable - - - - - 8408d521 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: merge_databases - - - - - fca2d25f by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: add UnitConfig datatype Avoid directly querying flags from DynFlags to build the UnitState. Instead go via UnitConfig so that we could reuse this to make another UnitState for plugins. - - - - - 4274688a by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move distrustAll into mkUnitState - - - - - 28d804e1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Create helper upd_wired_in_home_instantiations - - - - - ac964c83 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Put database cache in UnitConfig - - - - - bfd0a78c by Sylvain Henry at 2020-06-13T02:13:03-04:00 Don't return preload units when we set DyNFlags Preload units can be retrieved in UnitState when needed (i.e. in GHCi) - - - - - 1fbb4bf5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 NCGConfig: remove useless ncgUnitId field - - - - - c10ff7e7 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Doc: fix some comments - - - - - 456e17f0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Bump haddock submodule and allow metric decrease Metric Decrease: T12150 T12234 T5837 Metric Increase: T16190 - - - - - 42953902 by Simon Peyton Jones at 2020-06-13T02:13:03-04:00 Trim the demand for recursive product types Ticket #18304 showed that we need to be very careful when exploring the demand (esp usage demand) on recursive product types. This patch solves the problem by trimming the demand on such types -- in effect, a form of "widening". See the Note [Trimming a demand to a type] in DmdAnal, which explains how I did this by piggy-backing on an existing mechansim for trimming demands becuase of GADTs. The significant payload of this patch is very small indeed: * Make GHC.Core.Opt.WorkWrap.Utils.typeShape use RecTcChecker to avoid looking through recursive types. But on the way * I found that ae_rec_tc was entirely inoperative and did nothing. So I removed it altogether from DmdAnal. * I moved some code around in DmdAnal and Demand. (There are no actual changes in dmdFix.) * I changed the API of DmsAnal.dmdAnalRhsLetDown to return a StrictSig rather than a decorated Id * I removed the dead function peelTsFuns from Demand Performance effects: Nofib: 0.0% changes. Not surprising, because they don't use recursive products Perf tests T12227: 1% increase in compiler allocation, becuase $cto gets w/w'd. It did not w/w before because it takes a deeply nested argument, so the worker gets too many args, so we abandon w/w altogether (see GHC.Core.Opt.WorkWrap.Utils.isWorkerSmallEnough) With this patch we trim the demands. That is not strictly necessary (since these Generic type constructors are like tuples -- they can't cause a loop) but the net result is that we now w/w $cto which is fine. UniqLoop: 16% decrease in /runtime/ allocation. The UniqSupply is a recursive product, so currently we abandon all strictness on 'churn'. With this patch 'churn' gets useful strictness, and we w/w it. Hooray Metric Decrease: UniqLoop Metric Increase: T12227 - - - - - 87d504f4 by Viktor Dukhovni at 2020-06-13T02:13:05-04:00 Add introductory prose for Data.Traversable - - - - - 9f09b608 by Oleg Grenrus at 2020-06-13T02:13:07-04:00 Fix #12073: Add MonadFix Q instance - - - - - 220c2d34 by Ben Gamari at 2020-06-13T02:13:07-04:00 testsuite: Increase size of T12150 As noted in #18319, this test was previously very fragile. Increase its size to make it more likely that its fails with its newly-increased acceptance threshold. Metric Increase: T12150 - - - - - 8bba1c26 by Ben Gamari at 2020-06-13T04:59:06-04:00 gitlab-ci: Always push perf notes Previously we ci.sh would run with `set -e` implying that we wouldn't push perf notes if the testsuite were to fail, even if it *only* failed due to perf notes. This rendered the whole performance testing story quite fragile as a single regressing commit would cause every successive commit to fail since a new baseline would not be uploaded. Fix this by ensuring that we always push performance notes. - - - - - 7a773f16 by Ben Gamari at 2020-06-13T15:10:55-04:00 gitlab-ci: Eliminate redundant push of CI metrics - - - - - a31218f7 by Ryan Scott at 2020-06-13T15:58:37-04:00 Use HsForAllTelescope to avoid inferred, visible foralls Currently, `HsForAllTy` permits the combination of `ForallVis` and `Inferred`, but you can't actually typecheck code that uses it (e.g., `forall {a} ->`). This patch refactors `HsForAllTy` to use a new `HsForAllTelescope` data type that makes a type-level distinction between visible and invisible `forall`s such that visible `forall`s do not track `Specificity`. That part of the patch is actually quite small; the rest is simply changing consumers of `HsType` to accommodate this new type. Fixes #18235. Bumps the `haddock` submodule. - - - - - c0e6dee9 by Tamar Christina at 2020-06-14T09:07:44-04:00 winio: Add Atomic Exchange PrimOp and implement Atomic Ptr exchanges. The initial version was rewritten by Tamar Christina. It was rewritten in large parts by Andreas Klebinger. Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 9a7462fb by Ben Gamari at 2020-06-14T15:35:23-04:00 codeGen: Don't discard live case binders in unsafeEqualityProof logic Previously CoreToStg would unconditionally discard cases of the form: case unsafeEqualityProof of wild { _ -> rhs } and rather replace the whole thing with `rhs`. However, in some cases (see #18227) the case binder is still live, resulting in unbound occurrences in `rhs`. Fix this by only discarding the case if the case binder is dead. Fixes #18227. - - - - - e4137c48 by Ben Gamari at 2020-06-14T15:35:23-04:00 testsuite: Add tests for #18227 T18227A is the original issue which gave rise to the ticket and depends upon bytestring. T18227B is a minimized reproducer. - - - - - 8bab9ff1 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Fix rts include and library paths Fixes two bugs: * (?) and (<>) associated in a surprising way * We neglected to include libdw paths in the rts configure flags - - - - - bd761185 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Drop redundant GHC arguments Cabal should already be passing this arguments to GHC. - - - - - 01f7052c by Peter Trommler at 2020-06-14T15:36:38-04:00 FFI: Fix pass small ints in foreign call wrappers The Haskell calling convention requires integer parameters smaller than wordsize to be promoted to wordsize (where the upper bits are don't care). To access such small integer parameter read a word from the parameter array and then cast that word to the small integer target type. Fixes #15933 - - - - - 502647f7 by Krzysztof Gogolewski at 2020-06-14T15:37:14-04:00 Fix "ndecreasingIndentation" in manual (#18116) - - - - - 9a9cc089 by Simon Jakobi at 2020-06-15T13:10:00-04:00 Use foldl' in unionManyUniqDSets - - - - - 761dcb84 by Moritz Angermann at 2020-06-15T13:10:36-04:00 Load .lo as well. Some archives contain so called linker objects, with the affectionate .lo suffic. For example the musl libc.a will come in that form. We still want to load those objects, hence we should not discard them and look for .lo as well. Ultimately we might want to fix this proerly by looking at the file magic. - - - - - cf01477f by Vladislav Zavialov at 2020-06-15T13:11:20-04:00 User's Guide: KnownNat evidence is Natural This bit of documentation got outdated after commit 1fcede43d2b30f33b7505e25eb6b1f321be0407f - - - - - d0dcbfe6 by Jan Hrček at 2020-06-16T20:36:38+02:00 Fix typos and formatting in user guide - - - - - 56a9e95f by Jan Hrček at 2020-06-16T20:36:38+02:00 Resolve TODO - - - - - 3e884d14 by Jan Hrček at 2020-06-16T20:36:38+02:00 Rename TcHoleErrors to GHC.Tc.Errors.Hole - - - - - d23fc678 by Stefan Schulze Frielinghaus at 2020-06-17T15:31:09-04:00 hadrian: Build with threaded runtime if available See #16873. - - - - - 0639dc10 by Sylvain Henry at 2020-06-17T15:31:53-04:00 T16190: only measure bytes_allocated Just adding `{-# LANGUAGE BangPatterns #-}` makes the two other metrics fluctuate by 13%. - - - - - 4cab6897 by Adam Sandberg Ericsson at 2020-06-17T15:32:44-04:00 docs: fix formatting in users guide - - - - - eb8115a8 by Sylvain Henry at 2020-06-17T15:33:23-04:00 Move CLabel assertions into smart constructors (#17957) It avoids using DynFlags in the Outputable instance of Clabel to check assertions at pretty-printing time. - - - - - 7faa4509 by Ben Gamari at 2020-06-17T15:43:31-04:00 base: Bump to 4.15.0.0 - - - - - 20616959 by Ben Gamari at 2020-06-17T15:43:31-04:00 configure: Use grep -q instead of --quiet The latter is apparently not supported by busybox. - - - - - 40fa237e by Krzysztof Gogolewski at 2020-06-17T16:21:58-04:00 Linear types (#15981) This is the first step towards implementation of the linear types proposal (https://github.com/ghc-proposals/ghc-proposals/pull/111). It features * A language extension -XLinearTypes * Syntax for linear functions in the surface language * Linearity checking in Core Lint, enabled with -dlinear-core-lint * Core-to-core passes are mostly compatible with linearity * Fields in a data type can be linear or unrestricted; linear fields have multiplicity-polymorphic constructors. If -XLinearTypes is disabled, the GADT syntax defaults to linear fields The following items are not yet supported: * a # m -> b syntax (only prefix FUN is supported for now) * Full multiplicity inference (multiplicities are really only checked) * Decent linearity error messages * Linear let, where, and case expressions in the surface language (each of these currently introduce the unrestricted variant) * Multiplicity-parametric fields * Syntax for annotating lambda-bound or let-bound with a multiplicity * Syntax for non-linear/multiple-field-multiplicity records * Linear projections for records with a single linear field * Linear pattern synonyms * Multiplicity coercions (test LinearPolyType) A high-level description can be found at https://ghc.haskell.org/trac/ghc/wiki/LinearTypes/Implementation Following the link above you will find a description of the changes made to Core. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Matthew Pickering * Arnaud Spiwack With contributions from: * Mark Barbone * Alexander Vershilov Updates haddock submodule. - - - - - 6cb84c46 by Krzysztof Gogolewski at 2020-06-17T16:22:03-04:00 Various performance improvements This implements several general performance improvements to GHC, to offset the effect of the linear types change. General optimisations: - Add a `coreFullView` function which iterates `coreView` on the head. This avoids making function recursive solely because the iterate `coreView` themselves. As a consequence, this functions can be inlined, and trigger case-of-known constructor (_e.g._ `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`, `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`, `tyConAppTyCon_maybe`). The common pattern about all these functions is that they are almost always used as views, and immediately consumed by a case expression. This commit also mark them asx `INLINE`. - In `subst_ty` add a special case for nullary `TyConApp`, which avoid allocations altogether. - Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This required quite a bit of module shuffling. case. `myTyConApp` enforces crucial sharing, which was lost during substitution. See also !2952 . - Make `subst_ty` stricter. - In `eqType` (specifically, in `nonDetCmpType`), add a special case, tested first, for the very common case of nullary `TyConApp`. `nonDetCmpType` has been made `INLINE` otherwise it is actually a regression. This is similar to the optimisations in !2952. Linear-type specific optimisations: - Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in the definition of the pattern synonyms `One` and `Many`. - Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`: `Multiplicity` now import `Type` normally, rather than from the `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the `One` and `Many` pattern synonyms. - Make `updateIdTypeAndMult` strict in its type and multiplicity - The `scaleIdBy` gets a specialised definition rather than being an alias to `scaleVarBy` - `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type, Type)` instead of `Type -> Maybe (Scaled Type, Type)` - Remove the `MultMul` pattern synonym in favour of a view `isMultMul` because pattern synonyms appear not to inline well. - in `eqType`, in a `FunTy`, compare multiplicities last: they are almost always both `Many`, so it helps failing faster. - Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the instances of `TyConApp ManyDataConTy []` are physically the same. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Arnaud Spiwack Metric Decrease: haddock.base T12227 T12545 T12990 T1969 T3064 T5030 T9872b Metric Increase: haddock.base haddock.Cabal haddock.compiler T12150 T12234 T12425 T12707 T13035 T13056 T15164 T16190 T18304 T1969 T3064 T3294 T5631 T5642 T5837 T6048 T9020 T9233 T9675 T9872a T9961 WWRec - - - - - 57db91d8 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Remove integer-simple integer-simple uses lists of words (`[Word]`) to represent big numbers instead of ByteArray#: * it is less efficient than the newer ghc-bignum native backend * it isn't compatible with the big number representation that is now shared by all the ghc-bignum backends (based on the one that was used only in integer-gmp before). As a consequence, we simply drop integer-simple - - - - - 9f96bc12 by Sylvain Henry at 2020-06-17T16:22:03-04:00 ghc-bignum library ghc-bignum is a newer package that aims to replace the legacy integer-simple and integer-gmp packages. * it supports several backends. In particular GMP is still supported and most of the code from integer-gmp has been merged in the "gmp" backend. * the pure Haskell "native" backend is new and is much faster than the previous pure Haskell implementation provided by integer-simple * new backends are easier to write because they only have to provide a few well defined functions. All the other code is common to all backends. In particular they all share the efficient small/big number distinction previously used only in integer-gmp. * backends can all be tested against the "native" backend with a simple Cabal flag. Backends are only allowed to differ in performance, their results should be the same. * Add `integer-gmp` compat package: provide some pattern synonyms and function aliases for those in `ghc-bignum`. It is intended to avoid breaking packages that depend on `integer-gmp` internals. Update submodules: text, bytestring Metric Decrease: Conversions ManyAlternatives ManyConstructors Naperian T10359 T10547 T10678 T12150 T12227 T12234 T12425 T13035 T13719 T14936 T1969 T4801 T4830 T5237 T5549 T5837 T8766 T9020 parsing001 space_leak_001 T16190 haddock.base On ARM and i386, T17499 regresses (+6% > 5%). On x86_64 unregistered, T13701 sometimes regresses (+2.2% > 2%). Metric Increase: T17499 T13701 - - - - - 96aa5787 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update compiler Thanks to ghc-bignum, the compiler can be simplified: * Types and constructors of Integer and Natural can be wired-in. It means that we don't have to query them from interfaces. It also means that numeric literals don't have to carry their type with them. * The same code is used whatever ghc-bignum backend is enabled. In particular, conversion of bignum literals into final Core expressions is now much more straightforward. Bignum closure inspection too. * GHC itself doesn't depend on any integer-* package anymore * The `integerLibrary` setting is gone. - - - - - 0f67e344 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `base` package * GHC.Natural isn't implemented in `base` anymore. It is provided by ghc-bignum in GHC.Num.Natural. It means that we can safely use Natural primitives in `base` without fearing issues with built-in rewrite rules (cf #15286) * `base` doesn't conditionally depend on an integer-* package anymore, it depends on ghc-bignum * Some duplicated code in integer-* can now be factored in GHC.Float * ghc-bignum tries to use a uniform naming convention so most of the other changes are renaming - - - - - aa9e7b71 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `make` based build system * replace integer-* package selection with ghc-bignum backend selection - - - - - f817d816 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update testsuite * support detection of slow ghc-bignum backend (to replace the detection of integer-simple use). There are still some test cases that the native backend doesn't handle efficiently enough. * remove tests for GMP only functions that have been removed from ghc-bignum * fix test results showing dependent packages (e.g. integer-gmp) or showing suggested instances * fix test using Integer/Natural API or showing internal names - - - - - dceecb09 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update Hadrian * support ghc-bignum backend selection in flavours and command-line * support ghc-bignum "--check" flag (compare results of selected backend against results of the native one) in flavours and command-line (e.g. pass --bignum=check-gmp" to check the "gmp" backend) * remove the hack to workaround #15286 * build GMP only when the gmp backend is used * remove hacks to workaround `text` package flags about integer-*. We fix `text` to use ghc-bignum unconditionally in another patch - - - - - fa4281d6 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Bump bytestring and text submodules - - - - - 1a3f6f34 by Adam Sandberg Ericsson at 2020-06-18T23:03:36-04:00 docs: mention -hiedir in docs for -outputdir [skip ci] - - - - - 729bcb02 by Sylvain Henry at 2020-06-18T23:04:17-04:00 Hadrian: fix build on Mac OS Catalina (#17798) - - - - - 95e18292 by Andreas Klebinger at 2020-06-18T23:04:58-04:00 Relax allocation threshold for T12150. This test performs little work, so the most minor allocation changes often cause the test to fail. Increasing the threshold to 2% should help with this. - - - - - 8ce6c393 by Sebastian Graf at 2020-06-18T23:05:36-04:00 hadrian: Bump pinned cabal.project to an existent index-state - - - - - 08c1cb0f by Ömer Sinan Ağacan at 2020-06-18T23:06:21-04:00 Fix uninitialized field read in Linker.c Valgrind report of the bug when running the test `linker_unload`: ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x36C027A: loadArchive_ (LoadArchive.c:522) ==29666== by 0x36C0600: loadArchive (LoadArchive.c:626) ==29666== by 0x2C144CD: ??? (in /home/omer/haskell/ghc_2/testsuite/tests/rts/linker/linker_unload.run/linker_unload) ==29666== ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x369C9F6: preloadObjectFile (Linker.c:1507) ==29666== by 0x369CA8D: loadObj_ (Linker.c:1536) ==29666== by 0x369CB17: loadObj (Linker.c:1557) ==29666== by 0x3866BC: main (linker_unload.c:33) The problem is `mkOc` allocates a new `ObjectCode` and calls `setOcInitialStatus` without initializing the `status` field. `setOcInitialStatus` reads the field as first thing: static void setOcInitialStatus(ObjectCode* oc) { if (oc->status == OBJECT_DONT_RESOLVE) return; if (oc->archiveMemberName == NULL) { oc->status = OBJECT_NEEDED; } else { oc->status = OBJECT_LOADED; } } `setOcInitialStatus` is unsed in two places for two different purposes: in `mkOc` where we don't have the `status` field initialized yet (`mkOc` is supposed to initialize it), and `loadOc` where we do have `status` field initialized and we want to update it. Instead of splitting the function into two functions which are both called just once I inline the functions in the use sites and remove it. Fixes #18342 - - - - - da18ff99 by Tamar Christina at 2020-06-18T23:07:03-04:00 fix windows bootstrap due to linker changes - - - - - 2af0ec90 by Sylvain Henry at 2020-06-18T23:07:47-04:00 DynFlags: store default depth in SDocContext (#17957) It avoids having to use DynFlags to reach for pprUserLength. - - - - - d4a0be75 by Sylvain Henry at 2020-06-18T23:08:35-04:00 Move tablesNextToCode field into Platform tablesNextToCode is a platform setting and doesn't belong into DynFlags (#17957). Doing this is also a prerequisite to fix #14335 where we deal with two platforms (target and host) that may have different platform settings. - - - - - 809caedf by John Ericson at 2020-06-23T22:47:37-04:00 Switch from HscSource to IsBootInterface for module lookup in GhcMake We look up modules by their name, and not their contents. There is no way to separately reference a signature vs regular module; you get what you get. Only boot files can be referenced indepenently with `import {-# SOURCE #-}`. - - - - - 7750bd45 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Cmm: introduce SAVE_REGS/RESTORE_REGS We don't want to save both Fn and Dn register sets on x86-64 as they are aliased to the same arch register (XMMn). Moreover, when SAVE_STGREGS was used in conjunction with `jump foo [*]` which makes a set of Cmm registers alive so that they cover all arch registers used to pass parameter, we could have Fn, Dn and XMMn alive at the same time. It made the LLVM code generator choke (see #17920). Now `SAVE_REGS/RESTORE_REGS` and `jump foo [*]` use the same set of registers. - - - - - 2636794d by Sylvain Henry at 2020-06-23T22:48:18-04:00 CmmToC: don't add extern decl to parsed Cmm data Previously, if a .cmm file *not in the RTS* contained something like: ```cmm section "rodata" { msg : bits8[] "Test\n"; } ``` It would get compiled by CmmToC into: ```c ERW_(msg); const char msg[] = "Test\012"; ``` and fail with: ``` /tmp/ghc32129_0/ghc_4.hc:5:12: error: error: conflicting types for \u2018msg\u2019 const char msg[] = "Test\012"; ^~~ In file included from /tmp/ghc32129_0/ghc_4.hc:3:0: error: /tmp/ghc32129_0/ghc_4.hc:4:6: error: note: previous declaration of \u2018msg\u2019 was here ERW_(msg); ^ /builds/hsyl20/ghc/_build/install/lib/ghc-8.11.0.20200605/lib/../lib/x86_64-linux-ghc-8.11.0.20200605/rts-1.0/include/Stg.h:253:46: error: note: in definition of macro \u2018ERW_\u2019 #define ERW_(X) extern StgWordArray (X) ^ ``` See the rationale for this on https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes Now we don't generate these extern declarations (ERW_, etc.) for top-level data. It shouldn't change anything for the RTS (the only place we use .cmm files) as it is already special cased in `GHC.Cmm.CLabel.needsCDecl`. And hand-written Cmm can use explicit extern declarations when needed. Note that it allows `cgrun069` test to pass with CmmToC (cf #15467). - - - - - 5f6a0665 by Sylvain Henry at 2020-06-23T22:48:18-04:00 LLVM: refactor and comment register padding code (#17920) - - - - - cad62ef1 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Add tests for #17920 Metric Decrease: T12150 T12234 - - - - - a2a9006b by Xavier Denis at 2020-06-23T22:48:56-04:00 Fix issue #18262 by zonking constraints after solving Zonk residual constraints in checkForExistence to reveal user type errors. Previously when `:instances` was used with instances that have TypeError constraints the result would look something like: instance [safe] s0 => Err 'A -- Defined at ../Bug2.hs:8:10 whereas after zonking, `:instances` now sees the `TypeError` and properly eliminates the constraint from the results. - - - - - 181516bc by Simon Peyton Jones at 2020-06-23T22:49:33-04:00 Fix a buglet in Simplify.simplCast This bug, revealed by #18347, is just a missing update to sc_hole_ty in simplCast. I'd missed a code path when I made the recentchanges in commit 6d49d5be904c0c01788fa7aae1b112d5b4dfaf1c Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Thu May 21 12:53:35 2020 +0100 Implement cast worker/wrapper properly The fix is very easy. Two other minor changes * Tidy up in SimpleOpt.simple_opt_expr. In fact I think this is an outright bug, introduced in the fix to #18112: we were simplifying the same coercion twice *with the same substitution*, which is just wrong. It'd be a hard bug to trigger, so I just fixed it; less code too. * Better debug printing of ApplyToVal - - - - - 625a7f54 by Simon Peyton Jones at 2020-06-23T22:50:11-04:00 Two small tweaks to Coercion.simplifyArgsWorker These tweaks affect the inner loop of simplifyArgsWorker, which in turn is called from the flattener in Flatten.hs. This is a key perf bottleneck to T9872{a,b,c,d}. These two small changes have a modest but useful benefit. No change in functionality whatsoever. Relates to #18354 - - - - - b5768cce by Sylvain Henry at 2020-06-23T22:50:49-04:00 Don't use timesInt2# with GHC < 8.11 (fix #18358) - - - - - 7ad4085c by Sylvain Henry at 2020-06-23T22:51:27-04:00 Fix invalid printf format - - - - - a1f34d37 by Krzysztof Gogolewski at 2020-06-23T22:52:09-04:00 Add missing entry to freeNamesItem (#18369) - - - - - 03a708ba by Andreas Klebinger at 2020-06-25T03:54:37-04:00 Enable large address space optimization on windows. Starting with Win 8.1/Server 2012 windows no longer preallocates page tables for reserverd memory eagerly, which prevented us from using this approach in the past. We also try to allocate the heap high in the memory space. Hopefully this makes it easier to allocate things in the low 4GB of memory that need to be there. Like jump islands for the linker. - - - - - 7e6d3d09 by Roland Senn at 2020-06-25T03:54:38-04:00 In `:break ident` allow out of scope and nested identifiers (Fix #3000) This patch fixes the bug and implements the feature request of #3000. 1. If `Module` is a real module name and `identifier` a name of a top-level function in `Module` then `:break Module.identifer` works also for an `identifier` that is out of scope. 2. Extend the syntax for `:break identifier` to: :break [ModQual.]topLevelIdent[.nestedIdent]...[.nestedIdent] `ModQual` is optional and is either the effective name of a module or the local alias of a qualified import statement. `topLevelIdent` is the name of a top level function in the module referenced by `ModQual`. `nestedIdent` is optional and the name of a function nested in a let or where clause inside the previously mentioned function `nestedIdent` or `topLevelIdent`. If `ModQual` is a module name, then `topLevelIdent` can be any top level identifier in this module. If `ModQual` is missing or a local alias of a qualified import, then `topLevelIdent` must be in scope. Breakpoints can be set on arbitrarily deeply nested functions, but the whole chain of nested function names must be specified. 3. To support the new functionality rewrite the code to tab complete `:break`. - - - - - 30e42652 by Ben Gamari at 2020-06-25T03:54:39-04:00 make: Respect XELATEX variable Previously we simply ignored the XELATEX variable when building PDF documentation. - - - - - 4acc2934 by Ben Gamari at 2020-06-25T03:54:39-04:00 hadrian/make: Detect makeindex Previously we would simply assume that makeindex was available. Now we correctly detect it in `configure` and respect this conclusion in hadrian and make. - - - - - 0d61f866 by Simon Peyton Jones at 2020-06-25T03:54:40-04:00 Expunge GhcTcId GHC.Hs.Extension had type GhcPs = GhcPass 'Parsed type GhcRn = GhcPass 'Renamed type GhcTc = GhcPass 'Typechecked type GhcTcId = GhcTc The last of these, GhcTcId, is a vestige of the past. This patch expunges it from GHC. - - - - - 8ddbed4a by Adam Wespiser at 2020-06-25T03:54:40-04:00 add examples to Data.Traversable - - - - - 284001d0 by Oleg Grenrus at 2020-06-25T03:54:42-04:00 Export readBinIface_ - - - - - 90f43872 by Zubin Duggal at 2020-06-25T03:54:43-04:00 Export everything from HsToCore. This lets us reuse these functions in haddock, avoiding synchronization bugs. Also fixed some divergences with haddock in that file Updates haddock submodule - - - - - c7dd6da7 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part1) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Hs.* - GHC.Core.* - GHC.Stg.* - GHC.Cmm.* - GHC.Types.* - GHC.Data.* - GHC.Builtin.* - GHC.Parser.* - GHC.Driver.* - GHC top - - - - - 1eb997a8 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part2) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Iface.* - GHC.Llvm.* - GHC.Rename.* - GHC.Tc.* - GHC.HsToCore.* - GHC.StgToCmm.* - GHC.CmmToAsm.* - GHC.Runtime.* - GHC.Unit.* - GHC.Utils.* - GHC.SysTools.* - - - - - 67a86b4d by Oleg Grenrus at 2020-06-25T03:54:46-04:00 Add MonadZip and MonadFix instances for Complex These instances are taken from https://hackage.haskell.org/package/linear-1.21/docs/Linear-Instances.html They are the unique possible, so let they be in `base`. - - - - - c50ef26e by Artem Pelenitsyn at 2020-06-25T03:54:47-04:00 test suite: add reproducer for #17516 - - - - - fe281b27 by Roland Senn at 2020-06-25T03:54:48-04:00 Enable maxBound checks for OverloadedLists (Fixes #18172) Consider the Literal `[256] :: [Data.Word.Word8]` When the `OverloadedLists` extension is not active, then the `ol_ext` field in the `OverLitTc` record that is passed to the function `getIntegralLit` contains the type `Word8`. This is a simple type, and we can use its type constructor immediately for the `warnAboutOverflowedLiterals` function. When the `OverloadedLists` extension is active, then the `ol_ext` field contains the type family `Item [Word8]`. The function `nomaliseType` is used to convert it to the needed type `Word8`. - - - - - a788d4d1 by Ben Gamari at 2020-06-25T03:54:52-04:00 rts/Hash: Simplify freeing of HashListChunks While looking at #18348 I noticed that the treatment of HashLists are a bit more complex than necessary (which lead to some initial confusion on my part). Specifically, we allocate HashLists in chunks. Each chunk allocation makes two allocations: one for the chunk itself and one for a HashListChunk to link together the chunks for the purposes of freeing. Simplify this (and hopefully make the relationship between these clearer) but allocating the HashLists and HashListChunk in a single malloc. This will both make the implementation easier to follow and reduce C heap fragmentation. Note that even after this patch we fail to bound the size of the free HashList pool. However, this is a separate bug. - - - - - d3c2d59b by Sylvain Henry at 2020-06-25T03:54:55-04:00 RTS: avoid overflow on 32-bit arch (#18375) We're now correctly computing allocated bytes on 32-bit arch, so we get huge increases. Metric Increase: haddock.Cabal haddock.base haddock.compiler space_leak_001 - - - - - a3d69dc6 by Sebastian Graf at 2020-06-25T23:06:18-04:00 GHC.Core.Unify: Make UM actions one-shot by default This MR makes the UM monad in GHC.Core.Unify into a one-shot monad. See the long Note [The one-shot state monad trick]. See also #18202 and !3309, which applies this to all Reader/State-like monads in GHC for compile-time perf improvements. The pattern used here enables something similar to the state-hack, but is applicable to user-defined monads, not just `IO`. Metric Decrease 'runtime/bytes allocated' (test_env='i386-linux-deb9'): haddock.Cabal - - - - - 9ee58f8d by Matthias Pall Gissurarson at 2020-06-26T17:12:45+00:00 Implement the proposed -XQualifiedDo extension Co-authored-by: Facundo Domínguez <facundo.dominguez at tweag.io> QualifiedDo is implemented using the same placeholders for operation names in the AST that were devised for RebindableSyntax. Whenever the renamer checks which names to use for do syntax, it first checks if the do block is qualified (e.g. M.do { stmts }), in which case it searches for qualified names in the module M. This allows users to write {-# LANGUAGE QualifiedDo #-} import qualified SomeModule as M f x = M.do -- desugars to: y <- M.return x -- M.return x M.>>= \y -> M.return y -- M.return y M.>> M.return y -- M.return y See Note [QualifiedDo] and the users' guide for more details. Issue #18214 Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0216-qualified-do.rst Since we change the constructors `ITdo` and `ITmdo` to carry the new module name, we need to bump the haddock submodule to account or the new shape of these constructors. - - - - - ce987865 by Ryan Scott at 2020-06-27T11:55:21-04:00 Revamp the treatment of auxiliary bindings for derived instances This started as a simple fix for #18321 that organically grew into a much more sweeping refactor of how auxiliary bindings for derived instances are handled. I have rewritten `Note [Auxiliary binders]` in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but the highlights are: * Previously, the OccName of each auxiliary binding would be given a suffix containing a hash of its package name, module name, and parent data type to avoid name clashes. This was needlessly complicated, so we take the more direct approach of generating `Exact` `RdrName`s for each auxiliary binding with the same `OccName`, but using an underlying `System` `Name` with a fresh `Unique` for each binding. Unlike hashes, allocating new `Unique`s does not require any cleverness and avoid name clashes all the same... * ...speaking of which, in order to convince the renamer that multiple auxiliary bindings with the same `OccName` (but different `Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of `rnTopBindsLHS` to rename auxiliary bindings. Again, see `Note [Auxiliary binders]` for the full story. * I have removed the `DerivHsBind` constructor for `DerivStuff`—which was only used for `Data.Data`-related auxiliary bindings—and refactored `gen_Data_binds` to use `DerivAuxBind` instead. This brings the treatment of `Data.Data`-related auxiliary bindings in line with every other form of auxiliary binding. Fixes #18321. - - - - - a403eb91 by Sylvain Henry at 2020-06-27T11:55:59-04:00 ghc-bignum: fix division by zero (#18359) - - - - - 1b3d13b6 by Sylvain Henry at 2020-06-27T11:55:59-04:00 Fix ghc-bignum exceptions We must ensure that exceptions are not simplified. Previously we used: case raiseDivZero of _ -> 0## -- dummyValue But it was wrong because the evaluation of `raiseDivZero` was removed and the dummy value was directly returned. See new Note [ghc-bignum exceptions]. I've also removed the exception triggering primops which were fragile. We don't need them to be primops, we can have them exported by ghc-prim. I've also added a test for #18359 which triggered this patch. - - - - - a74ec37c by Simon Peyton Jones at 2020-06-27T11:56:34-04:00 Better loop detection in findTypeShape Andreas pointed out, in !3466, that my fix for #18304 was not quite right. This patch fixes it properly, by having just one RecTcChecker rather than (implicitly) two nested ones, in findTypeShape. - - - - - a04020b8 by Sylvain Henry at 2020-06-27T11:57:11-04:00 DynFlags: don't store buildTag `DynFlags.buildTag` was a field created from the set of Ways in `DynFlags.ways`. It had to be kept in sync with `DynFlags.ways` which was fragile. We want to avoid global state like this (#17957). Moreover in #14335 we also want to support loading units with different ways: target units would still use `DynFlags.ways` but plugins would use `GHC.Driver.Ways.hostFullWays`. To avoid having to deal both with build tag and with ways, we recompute the buildTag on-the-fly (should be pretty cheap) and we remove `DynFlags.buildTag` field. - - - - - 0e83efa2 by Krzysztof Gogolewski at 2020-06-27T11:57:49-04:00 Don't generalize when typechecking a tuple section The code is simpler and cleaner. - - - - - d8ba9e6f by Peter Trommler at 2020-06-28T09:19:11-04:00 RTS: Refactor Haskell-C glue for PPC 64-bit Make sure the stack is 16 byte aligned even when reserved stack bytes are not a multiple of 16 bytes. Avoid saving r2 (TOC). On ELF v1 the function descriptor of StgReturn has the same TOC as StgRun, on ELF v2 the TOC is recomputed in the function prologue. Use the ABI provided functions to save clobbered GPRs and FPRs. Improve comments. Describe what the stack looks like and how it relates to the respective ABIs. - - - - - 42f797b0 by Ryan Scott at 2020-06-28T09:19:46-04:00 Use NHsCoreTy to embed types into GND-generated code `GeneralizedNewtypeDeriving` is in the unique situation where it must produce an `LHsType GhcPs` from a Core `Type`. Historically, this was done with the `typeToLHsType` function, which walked over the entire `Type` and attempted to construct an `LHsType` with the same overall structure. `typeToLHsType` is quite complicated, however, and has been the subject of numerous bugs over the years (e.g., #14579). Luckily, there is an easier way to accomplish the same thing: the `XHsType` constructor of `HsType`. `XHsType` bundles an `NHsCoreTy`, which allows embedding a Core `Type` directly into an `HsType`, avoiding the need to laboriously convert from one to another (as `typeToLHsType` did). Moreover, renaming and typechecking an `XHsType` is simple, since one doesn't need to do anything to a Core `Type`... ...well, almost. For the reasons described in `Note [Typechecking NHsCoreTys]` in `GHC.Tc.Gen.HsType`, we must apply a substitution that we build from the local `tcl_env` type environment. But that's a relatively modest price to pay. Now that `GeneralizedNewtypeDeriving` uses `NHsCoreTy`, the `typeToLHsType` function no longer has any uses in GHC, so this patch rips it out. Some additional tweaks to `hsTypeNeedsParens` were necessary to make the new `-ddump-deriv` output correctly parenthesized, but other than that, this patch is quite straightforward. This is a mostly internal refactoring, although it is likely that `GeneralizedNewtypeDeriving`-generated code will now need fewer language extensions in certain situations than it did before. - - - - - 68530b1c by Jan Hrček at 2020-06-28T09:20:22-04:00 Fix duplicated words and typos in comments and user guide - - - - - 15b79bef by Ryan Scott at 2020-06-28T09:20:57-04:00 Add integer-gmp's ghc.mk and GNUmakefile to .gitignore - - - - - bfa5698b by Simon Peyton Jones at 2020-06-28T09:21:32-04:00 Fix a typo in Lint This simple error in GHC.Core.Litn.lintJoinLams meant that Lint reported bogus errors. Fixes #18399 - - - - - 71006532 by Ryan Scott at 2020-06-30T07:10:42-04:00 Reject nested foralls/contexts in instance types more consistently GHC is very wishy-washy about rejecting instance declarations with nested `forall`s or contexts that are surrounded by outermost parentheses. This can even lead to some strange interactions with `ScopedTypeVariables`, as demonstrated in #18240. This patch makes GHC more consistently reject instance types with nested `forall`s/contexts so as to prevent these strange interactions. On the implementation side, this patch tweaks `splitLHsInstDeclTy` and `getLHsInstDeclHead` to not look through parentheses, which can be semantically significant. I've added a `Note [No nested foralls or contexts in instance types]` in `GHC.Hs.Type` to explain why. This also introduces a `no_nested_foralls_contexts_err` function in `GHC.Rename.HsType` to catch nested `forall`s/contexts in instance types. This function is now used in `rnClsInstDecl` (for ordinary instance declarations) and `rnSrcDerivDecl` (for standalone `deriving` declarations), the latter of which fixes #18271. On the documentation side, this adds a new "Formal syntax for instance declaration types" section to the GHC User's Guide that presents a BNF-style grammar for what is and isn't allowed in instance types. Fixes #18240. Fixes #18271. - - - - - bccf3351 by Sylvain Henry at 2020-06-30T07:10:46-04:00 Add ghc-bignum to 8.12 release notes - - - - - 81704a6f by David Eichmann at 2020-06-30T07:10:48-04:00 Update ssh keys in CI performance metrics upload script - - - - - 85310fb8 by Joshua Price at 2020-06-30T07:10:49-04:00 Add missing Ix instances for tuples of size 6 through 15 (#16643) - - - - - cbb6b62f by Vladislav Zavialov at 2020-07-01T15:41:38-04:00 Implement -XLexicalNegation (GHC Proposal #229) This patch introduces a new extension, -XLexicalNegation, which detects whether the minus sign stands for negation or subtraction using the whitespace-based rules described in GHC Proposal #229. Updates haddock submodule. - - - - - fb5a0d01 by Martin Handley at 2020-07-01T15:42:14-04:00 #17169: Clarify Fixed's Enum instance. - - - - - b316804d by Simon Peyton Jones at 2020-07-01T15:42:49-04:00 Improve debug tracing for substitution This patch improves debug tracing a bit (#18395) * Remove the ancient SDoc argument to substitution, replacing it with a HasDebugCallStack constraint. The latter does the same job (indicate the call site) but much better. * Add HasDebugCallStack to simpleOptExpr, exprIsConApp_maybe I needed this to help nail the lookupIdSubst panic in #18326, #17784 - - - - - 5c9fabb8 by Hécate at 2020-07-01T15:43:25-04:00 Add most common return values for `os` and `arch` - - - - - 76d8cc74 by Ryan Scott at 2020-07-01T15:44:01-04:00 Desugar quoted uses of DerivingVia and expression type signatures properly The way that `GHC.HsToCore.Quote` desugared quoted `via` types (e.g., `deriving via forall a. [a] instance Eq a => Eq (List a)`) and explicit type annotations in signatures (e.g., `f = id @a :: forall a. a -> a`) was completely wrong, as it did not implement the scoping guidelines laid out in `Note [Scoped type variables in bindings]`. This is easily fixed. While I was in town, I did some minor cleanup of related Notes: * `Note [Scoped type variables in bindings]` and `Note [Scoped type variables in class and instance declarations]` say very nearly the same thing. I decided to just consolidate the two Notes into `Note [Scoped type variables in quotes]`. * `Note [Don't quantify implicit type variables in quotes]` is somewhat outdated, as it predates GHC 8.10, where the `forall`-or-nothing rule requires kind variables to be explicitly quantified in the presence of an explicit `forall`. As a result, the running example in that Note doesn't even compile. I have changed the example to something simpler that illustrates the same point that the original Note was making. Fixes #18388. - - - - - 44d6a335 by Andreas Klebinger at 2020-07-02T02:54:54-04:00 T16012: Be verbose on failure. - - - - - f9853330 by Ryan Scott at 2020-07-02T02:55:29-04:00 Bump ghc-prim version to 0.7.0 Fixes #18279. Bumps the `text` submodule. - - - - - 23e4e047 by Sylvain Henry at 2020-07-02T10:46:31-04:00 Hadrian: fix PowerPC64le support (#17601) [ci skip] - - - - - 3cdd8d69 by Sylvain Henry at 2020-07-02T10:47:08-04:00 NCG: correctly handle addresses with huge offsets (#15570) Before this patch we could generate addresses of this form: movzbl cP0_str+-9223372036854775808,%eax The linker can't handle them because the offset is too large: ld.lld: error: Main.o:(.text+0xB3): relocation R_X86_64_32S out of range: -9223372036852653050 is not in [-2147483648, 2147483647] With this patch we detect those cases and generate: movq $-9223372036854775808,%rax addq $cP0_str,%rax movzbl (%rax),%eax I've also refactored `getAmode` a little bit to make it easier to understand and to trace. - - - - - 4d90b3ff by Gabor Greif at 2020-07-02T20:07:59-04:00 No need for CURSES_INCLUDE_DIRS This is a leftover from ef63ff27251a20ff11e58c9303677fa31e609a88 - - - - - f08d6316 by Sylvain Henry at 2020-07-02T20:08:36-04:00 Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function SCC profiling was enabled in a convoluted way: if WayProf was enabled, Opt_SccProfilingOn general flag was set (in `GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in various places. There is no need to go via general flags, so this patch defines a `sccProfilingEnabled :: DynFlags -> Bool` helper function that just checks whether WayProf is enabled. - - - - - 8cc7274b by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Only allocate the Censuses that we need When not LDV profiling there is no reason to allocate 32 Censuses; one will do. This is a very small memory footprint optimisation, but it comes for free. - - - - - b835112c by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Free old allocations when reinitialising Censuses Previously when not LDV profiling we would repeatedly reinitialise `censuses[0]` with `initEra`. This failed to free the `Arena` and `HashTable` from the old census, resulting in a memory leak. Fixes #18348. - - - - - 34be6523 by Valery Tolstov at 2020-07-03T02:50:03-04:00 Mention flags that are not enabled by -Wall (#18372) * Mention missing flags that are not actually enabled by -Wall (docs/users_guide/using-warnings.rst) * Additionally remove -Wmissing-monadfail-instances from the list of flags enabled by -Wcompat, as it is not the case since 8.8 - - - - - edc8d22b by Sylvain Henry at 2020-07-03T02:50:40-04:00 LLVM: support R9 and R10 registers d535ef006d85dbdb7cda2b09c5bc35cb80108909 allowed the use of up to 10 vanilla registers but didn't update LLVM backend to support them. This patch fixes it. - - - - - 4bf18646 by Simon Peyton Jones at 2020-07-03T08:37:42+01:00 Improve handling of data type return kinds Following a long conversation with Richard, this patch tidies up the handling of return kinds for data/newtype declarations (vanilla, family, and instance). I have substantially edited the Notes in TyCl, so they would bear careful reading. Fixes #18300, #18357 In GHC.Tc.Instance.Family.newFamInst we were checking some Lint-like properties with ASSSERT. Instead Richard and I have added a proper linter for axioms, and called it from lintGblEnv, which in turn is called in tcRnModuleTcRnM New tests (T18300, T18357) cause an ASSERT failure in HEAD. - - - - - 41d26492 by Sylvain Henry at 2020-07-03T17:33:59-04:00 DynFlags: avoid the use of sdocWithDynFlags in GHC.Core.Rules (#17957) - - - - - 7aa6ef11 by Hécate at 2020-07-03T17:34:36-04:00 Add the __GHC_FULL_VERSION__ CPP macro to expose the full GHC version - - - - - e61d5395 by Chaitanya Koparkar at 2020-07-07T13:55:59-04:00 ghc-prim: Turn some comments into haddocks [ci skip] - - - - - 37743f91 by John Ericson at 2020-07-07T13:56:00-04:00 Support `timesInt2#` in LLVM backend - - - - - 46397e53 by John Ericson at 2020-07-07T13:56:00-04:00 `genericIntMul2Op`: Call `genericWordMul2Op` directly This unblocks a refactor, and removes partiality. It might be a PowerPC regression but that should be fixable. - - - - - 8a1c0584 by John Ericson at 2020-07-07T13:56:00-04:00 Simplify `PrimopCmmEmit` Follow @simonpj's suggestion of pushing the "into regs" logic into `emitPrimOp`. With the previous commit getting rid of the recursion in `genericIntMul2Op`, this is now an easy refactor. - - - - - 6607f203 by John Ericson at 2020-07-07T13:56:00-04:00 `opAllDone` -> `opIntoRegs` The old name was and terrible and became worse after the previous commit's refactor moved non-trivial funcationlity into its body. - - - - - fdcc53ba by Sylvain Henry at 2020-07-07T13:56:00-04:00 Optimise genericIntMul2Op We shouldn't directly call 'genericWordMul2Op' in genericIntMul2Op because a target may provide a faster primop for 'WordMul2Op': we'd better use it! - - - - - 686e7225 by Moritz Angermann at 2020-07-07T13:56:01-04:00 [linker/rtsSymbols] More linker symbols Mostly symbols needed for aarch64/armv7l and in combination with musl, where we have to rely on loading *all* objects/archives - __stack_chk_* only when not DYNAMIC - - - - - 3f60b94d by Moritz Angermann at 2020-07-07T13:56:01-04:00 better if guards. - - - - - 7abffced by Moritz Angermann at 2020-07-07T13:56:01-04:00 Fix (1) - - - - - cdfeb3f2 by Moritz Angermann at 2020-07-07T13:56:01-04:00 AArch32 symbols only on aarch32. - - - - - f496c955 by Adam Sandberg Ericsson at 2020-07-07T13:56:02-04:00 add -flink-rts flag to link the rts when linking a shared or static library #18072 By default we don't link the RTS when linking shared libraries because in the most usual mode a shared library is an intermediary product, for example a Haskell library, that will be linked into some executable in the end. So we wish to defer the RTS flavour to link to the final link. However sometimes the final product is the shared library, for example when writing a plugin for some other system, so we do wish the shared library to link the RTS. For consistency we also make -staticlib honor this flag and its inversion. -staticlib currently implies -flink-shared. - - - - - c59faf67 by Stefan Schulze Frielinghaus at 2020-07-07T13:56:04-04:00 hadrian: link check-ppr against debugging RTS if ghcDebugged - - - - - 0effc57d by Adam Sandberg Ericsson at 2020-07-07T13:56:05-04:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 - - - - - 96153433 by Adam Sandberg Ericsson at 2020-07-07T13:56:06-04:00 hadrian: make hadrian/ghci use the bootstrap compiler from configure #18190 - - - - - 4d24f886 by Adam Sandberg Ericsson at 2020-07-07T13:56:07-04:00 hadrian: ignore cabal configure verbosity related flags #18131 - - - - - 7332bbff by Ben Gamari at 2020-07-07T13:56:08-04:00 testsuite: Widen T12234 acceptance window to 2% Previously it wasn't uncommon to see +/-1% fluctuations in compiler allocations on this test. - - - - - 180b6313 by Gabor Greif at 2020-07-07T13:56:08-04:00 When running libtool, report it as such - - - - - d3bd6897 by Sylvain Henry at 2020-07-07T13:56:11-04:00 BigNum: rename BigNat types Before this patch BigNat names were confusing because we had: * GHC.Num.BigNat.BigNat: unlifted type used everywhere else * GHC.Num.BigNat.BigNatW: lifted type only used to share static constants * GHC.Natural.BigNat: lifted type only used for backward compatibility After this patch we have: * GHC.Num.BigNat.BigNat#: unlifted type * GHC.Num.BigNat.BigNat: lifted type (reexported from GHC.Natural) Thanks to @RyanGlScott for spotting this. - - - - - 929d26db by Sylvain Henry at 2020-07-07T13:56:12-04:00 Bignum: don't build ghc-bignum with stage0 Noticed by @Ericson2314 - - - - - d25b6851 by Sylvain Henry at 2020-07-07T13:56:12-04:00 Hadrian: ghc-gmp.h shouldn't be a compiler dependency - - - - - 0ddae2ba by Sylvain Henry at 2020-07-07T13:56:14-04:00 DynFlags: factor out pprUnitId from "Outputable UnitId" instance - - - - - 204f3f5d by Krzysztof Gogolewski at 2020-07-07T13:56:18-04:00 Remove unused function pprHsForAllExtra (#18423) The function `pprHsForAllExtra` was called only on `Nothing` since 2015 (1e041b7382b6aa). - - - - - 3033e0e4 by Adam Sandberg Ericsson at 2020-07-08T20:36:49-04:00 hadrian: add flag to skip rebuilding dependency information #17636 - - - - - b7de4b96 by Stefan Schulze Frielinghaus at 2020-07-09T09:49:22-04:00 Fix GHCi :print on big-endian platforms On big-endian platforms executing import GHC.Exts data Foo = Foo Float# deriving Show foo = Foo 42.0# foo :print foo results in an arithmetic overflow exception which is caused by function index where moveBytes equals word_size - (r + item_size_b) * 8 Here we have a mixture of units. Both, word_size and item_size_b have unit bytes whereas r has unit bits. On 64-bit platforms moveBytes equals then 8 - (0 + 4) * 8 which results in a negative and therefore invalid second parameter for a shiftL operation. In order to make things more clear the expression (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes is equivalent to (word `shiftR` moveBytes) .&. mask On big-endian platforms the shift must be a left shift instead of a right shift. For symmetry reasons not a mask is used but two shifts in order to zero out bits. Thus the fixed version equals case endian of BigEndian -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits Fixes #16548 and #14455 - - - - - 3656dff8 by Sylvain Henry at 2020-07-09T09:50:01-04:00 LLVM: fix MO_S_Mul2 support (#18434) The value indicating if the carry is useful wasn't taken into account. - - - - - d9f09506 by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Define multiShotIO and use it in mkSplitUniqueSupply This patch is part of the ongoing eta-expansion saga; see #18238. It implements a neat trick (suggested by Sebastian Graf) that allows the programmer to disable the default one-shot behaviour of IO (the "state hack"). The trick is to use a new multiShotIO function; see Note [multiShotIO]. For now, multiShotIO is defined here in Unique.Supply; but it should ultimately be moved to the IO library. The change is necessary to get good code for GHC's unique supply; see Note [Optimising the unique supply]. However it makes no difference to GHC as-is. Rather, it makes a difference when a subsequent commit Improve eta-expansion using ArityType lands. - - - - - bce695cc by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Make arityType deal with join points As Note [Eta-expansion and join points] describes, this patch makes arityType deal correctly with join points. What was there before was not wrong, but yielded lower arities than it could. Fixes #18328 In base GHC this makes no difference to nofib. Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- n-body -0.1% -0.1% -1.2% -1.1% 0.0% -------------------------------------------------------------------------------- Min -0.1% -0.1% -55.0% -56.5% 0.0% Max -0.0% 0.0% +16.1% +13.4% 0.0% Geometric Mean -0.0% -0.0% -30.1% -31.0% -0.0% But it starts to make real difference when we land the change to the way mkDupableAlts handles StrictArg, in fixing #13253 and friends. I think this is because we then get more non-inlined join points. - - - - - 2b7c71cb by Simon Peyton Jones at 2020-07-11T12:17:02-04:00 Improve eta-expansion using ArityType As #18355 shows, we were failing to preserve one-shot info when eta-expanding. It's rather easy to fix, by using ArityType more, rather than just Arity. This patch is important to suport the one-shot monad trick; see #18202. But the extra tracking of one-shot-ness requires the patch Define multiShotIO and use it in mkSplitUniqueSupply If that patch is missing, ths patch makes things worse in GHC.Types.Uniq.Supply. With it, however, we see these improvements T3064 compiler bytes allocated -2.2% T3294 compiler bytes allocated -1.3% T12707 compiler bytes allocated -1.3% T13056 compiler bytes allocated -2.2% Metric Decrease: T3064 T3294 T12707 T13056 - - - - - de139cc4 by Artem Pelenitsyn at 2020-07-12T02:53:20-04:00 add reproducer for #15630 - - - - - c4de6a7a by Andreas Klebinger at 2020-07-12T02:53:55-04:00 Give Uniq[D]FM a phantom type for its key. This fixes #17667 and should help to avoid such issues going forward. The changes are mostly mechanical in nature. With two notable exceptions. * The register allocator. The register allocator references registers by distinct uniques. However they come from the types of VirtualReg, Reg or Unique in various places. As a result we sometimes cast the key type of the map and use functions which operate on the now typed map but take a raw Unique as actual key. The logic itself has not changed it just becomes obvious where we do so now. * <Type>Env Modules. As an example a ClassEnv is currently queried using the types `Class`, `Name`, and `TyCon`. This is safe since for a distinct class value all these expressions give the same unique. getUnique cls getUnique (classTyCon cls) getUnique (className cls) getUnique (tcName $ classTyCon cls) This is for the most part contained within the modules defining the interface. However it requires us to play dirty when we are given a `Name` to lookup in a `UniqFM Class a` map. But again the logic did not change and it's for the most part hidden behind the Env Module. Some of these cases could be avoided by refactoring but this is left for future work. We also bump the haddock submodule as it uses UniqFM. - - - - - c2cfdfde by Aaron Allen at 2020-07-13T09:00:33-04:00 Warn about empty Char enumerations (#18402) Currently the "Enumeration is empty" warning (-Wempty-enumerations) only fires for numeric literals. This patch adds support for `Char` literals so that enumerating an empty list of `Char`s will also trigger the warning. - - - - - c3ac87ec by Stefan Schulze Frielinghaus at 2020-07-13T09:01:10-04:00 hadrian: build check-ppr dynamic if GHC is build dynamic Fixes #18361 - - - - - 9ad072b4 by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Use dumpStyle when printing inlinings This just makes debug-printing consistent, and more informative. - - - - - e78c4efb by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Comments only - - - - - 7ccb760b by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Reduce result discount in conSize Ticket #18282 showed that the result discount given by conSize was massively too large. This patch reduces that discount to a constant 10, which just balances the cost of the constructor application itself. Note [Constructor size and result discount] elaborates, as does the ticket #18282. Reducing result discount reduces inlining, which affects perf. I found that I could increase the unfoldingUseThrehold from 80 to 90 in compensation; in combination with the result discount change I get these overall nofib numbers: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- boyer -0.2% +5.4% -3.2% -3.4% 0.0% cichelli -0.1% +5.9% -11.2% -11.7% 0.0% compress2 -0.2% +9.6% -6.0% -6.8% 0.0% cryptarithm2 -0.1% -3.9% -6.0% -5.7% 0.0% gamteb -0.2% +2.6% -13.8% -14.4% 0.0% genfft -0.1% -1.6% -29.5% -29.9% 0.0% gg -0.0% -2.2% -17.2% -17.8% -20.0% life -0.1% -2.2% -62.3% -63.4% 0.0% mate +0.0% +1.4% -5.1% -5.1% -14.3% parser -0.2% -2.1% +7.4% +6.7% 0.0% primetest -0.2% -12.8% -14.3% -14.2% 0.0% puzzle -0.2% +2.1% -10.0% -10.4% 0.0% rsa -0.2% -11.7% -3.7% -3.8% 0.0% simple -0.2% +2.8% -36.7% -38.3% -2.2% wheel-sieve2 -0.1% -19.2% -48.8% -49.2% -42.9% -------------------------------------------------------------------------------- Min -0.4% -19.2% -62.3% -63.4% -42.9% Max +0.3% +9.6% +7.4% +11.0% +16.7% Geometric Mean -0.1% -0.3% -17.6% -18.0% -0.7% I'm ok with these numbers, remembering that this change removes an *exponential* increase in code size in some in-the-wild cases. I investigated compress2. The difference is entirely caused by this function no longer inlining WriteRoutines.$woutputCodes = \ (w :: [CodeEvent]) -> let result_s1Sr = case WriteRoutines.outputCodes_$s$woutput w 0# 0# 8# 9# of (# ww1, ww2 #) -> (ww1, ww2) in (# case result_s1Sr of (x, _) -> map @Int @Char WriteRoutines.outputCodes1 x , case result_s1Sr of { (_, y) -> y } #) It was right on the cusp before, driven by the excessive result discount. Too bad! Happily, the compiler/perf tests show a number of improvements: T12227 compiler bytes-alloc -6.6% T12545 compiler bytes-alloc -4.7% T13056 compiler bytes-alloc -3.3% T15263 runtime bytes-alloc -13.1% T17499 runtime bytes-alloc -14.3% T3294 compiler bytes-alloc -1.1% T5030 compiler bytes-alloc -11.7% T9872a compiler bytes-alloc -2.0% T9872b compiler bytes-alloc -1.2% T9872c compiler bytes-alloc -1.5% Metric Decrease: T12227 T12545 T13056 T15263 T17499 T3294 T5030 T9872a T9872b T9872c - - - - - 7f0b671e by Ben Gamari at 2020-07-13T14:52:49-04:00 testsuite: Widen acceptance threshold on T5837 This test is positively tiny and consequently the bytes allocated measurement will be relatively noisy. Consequently I have seen this fail spuriously quite often. - - - - - 118e1c3d by Alp Mestanogullari at 2020-07-14T21:30:52-04:00 compiler: re-engineer the treatment of rebindable if Executing on the plan described in #17582, this patch changes the way if expressions are handled in the compiler in the presence of rebindable syntax. We get rid of the SyntaxExpr field of HsIf and instead, when rebindable syntax is on, we rewrite the HsIf node to the appropriate sequence of applications of the local `ifThenElse` function. In order to be able to report good error messages, with expressions as they were written by the user (and not as desugared by the renamer), we make use of TTG extensions to extend GhcRn expression ASTs with an `HsExpansion` construct, which keeps track of a source (GhcPs) expression and the desugared (GhcRn) expression that it gives rise to. This way, we can typecheck the latter while reporting the former in error messages. In order to discard the error context lines that arise from typechecking the desugared expressions (because they talk about expressions that the user has not written), we carefully give a special treatment to the nodes fabricated by this new renaming-time transformation when typechecking them. See Note [Rebindable syntax and HsExpansion] for more details. The note also includes a recipe to apply the same treatment to other rebindable constructs. Tests 'rebindable11' and 'rebindable12' have been added to make sure we report identical error messages as before this patch under various circumstances. We also now disable rebindable syntax when processing untyped TH quotes, as per the discussion in #18102 and document the interaction of rebindable syntax and Template Haskell, both in Note [Template Haskell quotes and Rebindable Syntax] and in the user guide, adding a test to make sure that we do not regress in that regard. - - - - - 64c774b0 by Andreas Klebinger at 2020-07-14T21:31:27-04:00 Explain why keeping DynFlags in AnalEnv saves allocation. - - - - - 254245d0 by Ben Gamari at 2020-07-14T21:32:03-04:00 docs/users-guide: Update default -funfolding-use-threshold value This was changed in 3d2991f8 but I neglected to update the documentation. Fixes #18419. - - - - - 4c259f86 by Andreas Klebinger at 2020-07-14T21:32:41-04:00 Escape backslashes in json profiling reports properly. I also took the liberty to do away the fixed buffer size for escaping. Using a fixed size here can only lead to issues down the line. Fixes #18438. - - - - - 23797224 by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 .gitlab: re-enable integer-simple substitute (BIGNUM_BACKEND) Recently build system migrated from INTEGER_LIBRARY to BIGNUM_BACKEND. But gitlab CI was never updated. Let's enable BIGNUM_BACKEND=native. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e0db878a by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 ghc-bignum: bring in sync .hs-boot files with module declarations Before this change `BIGNUM_BACKEND=native` build was failing as: ``` libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs:708:16: error: * Variable not in scope: naturalFromBigNat# :: WordArray# -> t * Perhaps you meant one of these: `naturalFromBigNat' (imported from GHC.Num.Natural), `naturalToBigNat' (imported from GHC.Num.Natural) | 708 | m' = naturalFromBigNat# m | ``` This happens because `.hs-boot` files are slightly out of date. This change brings in data and function types in sync. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - c9f65c36 by Stefan Schulze Frielinghaus at 2020-07-14T21:33:57-04:00 rts/Disassembler.c: Use FMT_HexWord for printing values in hex format - - - - - 58ae62eb by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 macOS: Load frameworks without stating them first. macOS Big Sur makes the following change to how frameworks are shipped with the OS: > New in macOS Big Sur 11 beta, the system ships with a built-in > dynamic linker cache of all system-provided libraries. As part of > this change, copies of dynamic libraries are no longer present on > the filesystem. Code that attempts to check for dynamic library > presence by looking for a file at a path or enumerating a directory > will fail. Instead, check for library presence by attempting to > dlopen() the path, which will correctly check for the library in the > cache. (62986286) https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/ Therefore, the previous method of checking whether a library exists before attempting to load it makes GHC.Runtime.Linker.loadFramework fail to find frameworks installed at /System/Library/Frameworks. GHC.Runtime.Linker.loadFramework now opportunistically loads the framework libraries without checking for their existence first, failing only if all attempts to load a given framework from any of the various possible locations fail. - - - - - cdc4a6b0 by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 loadFramework: Output the errors collected in all loading attempts. With the recent change away from first finding and then loading a framework, loadFramework had no way of communicating the real reason why loadDLL failed if it was any reason other than the framework missing from the file system. It now collects all loading attempt errors into a list and concatenates them into a string to return to the caller. - - - - - 51dbfa52 by Ben Gamari at 2020-07-15T04:05:34-04:00 StgToCmm: Use CmmRegOff smart constructor Previously we would generate expressions of the form `CmmRegOff BaseReg 0`. This should do no harm (and really should be handled by the NCG anyways) but it's better to just generate a plain `CmmReg`. - - - - - ae11bdfd by Ben Gamari at 2020-07-15T04:06:08-04:00 testsuite: Add regression test for #17744 Test due to @monoidal. - - - - - 0e3c277a by Ben Gamari at 2020-07-15T16:41:01-04:00 Bump Cabal submodule Updates a variety of tests as Cabal is now more strict about Cabal file form. - - - - - ceed994a by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Drop Windows Vista support, require Windows 7 - - - - - 00a23bfd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Update Windows FileSystem wrapper utilities. - - - - - 459e1c5f by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Use SlimReaderLocks and ConditonalVariables provided by the OS instead of emulated ones - - - - - 763088fc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Small linker comment and ifdef cleanups - - - - - 1a228ff9 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Flush event logs eagerly. - - - - - e9e04dda by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Refactor Buffer structures to be able to track async operations - - - - - 356dc3fe by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Implement new Console API - - - - - 90e69f77 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add IOPort synchronization primitive - - - - - 71245fcc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add new io-manager cmdline options - - - - - d548a3b3 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Init Windows console Codepage to UTF-8. - - - - - 58ef6366 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add unsafeSplat to GHC.Event.Array - - - - - d660725e by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add size and iterate to GHC.Event.IntTable. - - - - - 050da6dd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Switch Testsuite to test winio by default - - - - - 4bf542bf by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Multiple refactorings and support changes. - - - - - 4489af6b by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core threaded I/O manager - - - - - 64d8f2fe by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core non-threaded I/O manager - - - - - 8da15a09 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix a scheduler bug with the threaded-runtime. - - - - - 84ea3d14 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Relaxing some constraints in io-manager. - - - - - ccf0d107 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix issues with non-threaded I/O manager after split. - - - - - b492fe6e by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Remove some barf statements that are a bit strict. - - - - - 01423fd2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Expand comments describing non-threaded loop - - - - - 4b69004f by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: fix FileSize unstat-able handles - - - - - 9b384270 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Implement new tempfile routines for winio - - - - - f1e0be82 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix input truncation when reading from handle. This was caused by not upholding the read buffer invariant that bufR == bufL == 0 for empty read buffers. - - - - - e176b625 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix output truncation for writes larger than buffer size - - - - - a831ce0e by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Rewrite bufWrite. I think it's far easier to follow the code now. It's also correct now as I had still missed a spot where we didn't update the offset. - - - - - 6aefdf62 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix offset set by bufReadEmpty. bufReadEmpty returns the bytes read *including* content that was already buffered, But for calculating the offset we only care about the number of bytes read into the new buffer. - - - - - 750ebaee by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Clean up code surrounding IOPort primitives. According to phyx these should only be read and written once per object. Not neccesarily in that order. To strengthen that guarantee the primitives will now throw an exception if we violate this invariant. As a consequence we can eliminate some code from their primops. In particular code dealing with multiple queued readers/writers now simply checks the invariant and throws an exception if it was violated. That is in contrast to mvars which will do things like wake up all readers, queue multi writers etc. - - - - - ffd31db9 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix multi threaded threadDelay and a few other small changes. Multithreaded threadDelay suffered from a race condition based on the ioManagerStatus. Since the status isn't needed for WIO I removed it completely. This resulted in a light refactoring, as consequence we will always wake up the IO manager using interruptSystemManager, which uses `postQueuedCompletionStatus` internally. I also added a few comments which hopefully makes the code easier to dive into for the next person diving in. - - - - - 6ec26df2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 wionio: Make IO subsystem check a no-op on non-windows platforms. - - - - - 29bcd936 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Set handle offset when opening files in Append mode. Otherwise we would truncate the file. - - - - - 55c29700 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Remove debug event log trace - - - - - 9acb9f40 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix sqrt and openFile009 test cases - - - - - 57017cb7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Allow hp2ps to build with -DDEBUG - - - - - b8cd9995 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update output of T9681 since we now actually run it. - - - - - 10af5b14 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: A few more improvements to the IOPort primitives. - - - - - 39afc4a7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix expected tempfiles output. Tempfiles now works properly on windows, as such we can delete the win32 specific output. - - - - - 99db46e0 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Assign thread labels to IOManager threads. - - - - - be6af732 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Properly check for the tso of an incall to be zero. - - - - - e2c6dac7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark FD instances as unsupported under WINIO. - - - - - fd02ceed by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix threadDelay maxBound invocations. Instead of letting the ns timer overflow now clamp it at (maxBound :: Word64) ns. That still gives a few hundred years. - - - - - bc79f9f1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comments/cleanup an import in base - - - - - 1d197f4b by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark outstanding_service_requests volatile. As far as I know C(99) gives no guarantees for code like bool condition; ... while(condition) sleep(); that condition will be updated if it's changed by another thread. So we are explicit here and mark it as volatile, this will force a reload from memory on each iteration. - - - - - dc438186 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Make last_event a local variable - - - - - 2fc957c5 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comment about thread safety of processCompletion. - - - - - 4c026b6c by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: nonthreaded: Create io processing threads in main thread. We now set a flag in the IO thread. The scheduler when looking for work will check the flag and create/queue threads accordingly. We used to create these in the IO thread. This improved performance but caused frequent segfaults. Thread creation/allocation is only safe to do if nothing currently accesses the storeagemanager. However without locks in the non-threaded runtime this can't be guaranteed. This shouldn't change performance all too much. In the past we had: * IO: Create/Queue thread. * Scheduler: Runs a few times. Eventually picks up IO processing thread. Now it's: * IO: Set flag to queue thread. * Scheduler: Pick up flag, if set create/queue thread. Eventually picks up IO processing thread. - - - - - f47c7208 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add an exported isHeapAlloced function to the RTS - - - - - cc5d7bb1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Queue IO processing threads at the front of the queue. This will unblock the IO thread sooner hopefully leading to higher throughput in some situations. - - - - - e7630115 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: ThreadDelay001: Use higher resolution timer. - - - - - 451b5f96 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update T9681 output, disable T4808 on windows. T4808 tests functionality of the FD interface which won't be supported under WINIO. T9681 just has it's expected output tweaked. - - - - - dd06f930 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Wake io manager once per registerTimeout. Which is implicitly done in editTimeouts, so need to wake it up twice. - - - - - e87d0bf9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update placeholder comment with actual function name. - - - - - fc9025db by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Always lock win32 event queue - - - - - c24c9a1f by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Display thread labels when tracing scheduler events. - - - - - 06542b03 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Refactor non-threaded runner thread and scheduler interface. Only use a single communication point (registerAlertableWait) to inform the C side aobut both timeouts to use as well as outstanding requests. Also queue a haskell processing thread after each return from alertable waits. This way there is no risk of us missing a timer event. - - - - - 256299b1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove outstanding_requests from runner. We used a variable to keep track of situations where we got entries from the IO port, but all of them had already been canceled. While we can avoid some work that way this case seems quite rare. So we give up on tracking this and instead always assume at least one of the returned entries is valid. If that's not the case no harm is done, we just perform some additional work. But it makes the runner easier to reason about. In particular we don't need to care if another thread modifies oustanding_requests after we return from waiting on the IO Port. - - - - - 3ebd8ad9 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Various fixes related to rebase and testdriver - - - - - 6be6bcba by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Fix rebase artifacts - - - - - 2c649dc3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename unsafeSplat to unsafeCopyFromBuffer - - - - - a18b73f3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove unused size/iterate operations from IntTable - - - - - 16bab48e by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Detect running IO Backend via peeking at RtsConfig - - - - - 8b8405a0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update temp path so GCC etc can handle it. Also fix PIPE support, clean up error casting, fix memory leaks - - - - - 2092bc54 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Minor comments/renamings - - - - - a5b5b6c0 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Checking if an error code indicates completion is now a function. - - - - - 362176fd by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Small refactor in withOverlappedEx - - - - - 32e20597 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: A few comments and commented out dbxIO - - - - - a4bfc1d9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't drop buffer offset in byteView/cwcharView - - - - - b3ad2a54 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: revert BHandle changes. - - - - - 3dcd87e2 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Fix imports - - - - - 5a371890 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update ghc-cabal to handle new Cabal submodule bump - - - - - d07ebe0d by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Only compile sources on Windows - - - - - dcb42393 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Actually return Nothing on EOF for non-blocking read - - - - - 895a3beb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate logic in encodeMultiByte[Raw]IO. - - - - - e06e6734 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate openFile logic - - - - - b59430c0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: fix -werror issue in encoding file - - - - - f8d39a51 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't mention windows specific functions when building on Linux. - - - - - 6a533d2a by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add a note about file locking in the RTS. - - - - - cf37ce34 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Add version to @since annotation - - - - - 0fafa2eb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename GHC.Conc.IOCP -> GHC.Conc.WinIO - - - - - 1854fc23 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Expand GHC.Conc.POSIX description It now explains users may not use these functions when using the old IO manager. - - - - - fcc7ba41 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Fix potential spaceleak in __createUUIDTempFileErrNo - - - - - 6b3fd9fa by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant -Wno-missing-signatures pragmas - - - - - 916fc861 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Make it explicit that we only create one IO manager - - - - - f260a721 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Note why we don't use blocking waits. - - - - - aa0a4bbf by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove commented out pragma - - - - - d679b544 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant buffer write in Handle/Text.hs:bufReadEmpty - - - - - d3f94368 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename SmartHandles to StdHandles - - - - - bd6b8ec1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add comment stating failure behaviour for getUniqueFileInfo. - - - - - 12846b85 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update IOPort haddocks. - - - - - 9f39fb14 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Add a note cross reference - - - - - 62dd5a73 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Name Haskell/OS I/O Manager explicitly in Note - - - - - fa807828 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Expand BlockedOnIOCompletion description. - - - - - f0880a1d by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove historical todos - - - - - 8e58e714 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Update note, remove debugging pragma. - - - - - aa4d84d5 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: flushCharReadBuffer shouldn't need to adjust offsets. - - - - - e580893a by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove obsolete comment about cond. variables - - - - - d54e9d79 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix initial linux validate build - - - - - 3cd4de46 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix ThreadDelay001 CPP - - - - - c88b1b9f by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix openFile009 merge conflict leftover - - - - - 849e8889 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept T9681 output. GHC now reports String instead of [Char]. - - - - - e7701818 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix cabal006 after upgrading cabal submodule Demand cabal 2.0 syntax instead of >= 1.20 as required by newer cabal versions. - - - - - a44f0373 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix stderr output for ghci/linking/dyn tests. We used to filter rtsopts, i opted to instead just accept the warning of it having no effect. This works both for -rtsopts, as well as -with-rtsopts which winio adds. - - - - - 515d9896 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T15261b stdout for --io-manager flag. - - - - - 949aaacc by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T5435_dyn_asm stderr The warning about rtsopts having no consequences is expected. So accept new stderr. - - - - - 7d424e1e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Also accept T7037 stderr - - - - - 1f009768 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal04 by filtering rts args - - - - - 981a9f2e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal01 by accepting expected stderr - - - - - b7b0464e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix safePkg01 by accepting expected stderr - - - - - 32734b29 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix T5435_dyn_gcc by accepting expected stderr - - - - - acc5cebf by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix tempfiles test on linux - - - - - c577b789 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for T3807 - - - - - c108c527 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload - - - - - 2b0b9a08 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload_multiple_objs - - - - - 67afb03c by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify wording on conditional variables. - - - - - 3bd41572 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify comment on cooked mode. - - - - - ded58a03 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: update lockfile signature and remove mistaken symbol in rts. - - - - - 2143c492 by Ben Gamari at 2020-07-15T16:41:04-04:00 testsuite: Add winio and winio_threaded ways Reverts many of the testsuite changes - - - - - c0979cc5 by Ben Gamari at 2020-07-16T10:56:54-04:00 Merge remote-tracking branch 'origin/wip/winio' - - - - - 750a1595 by Ben Gamari at 2020-07-18T07:26:41-04:00 rts: Add --copying-gc flag to reverse effect of --nonmoving-gc Fixes #18281. - - - - - 6ba6a881 by Hécate at 2020-07-18T07:26:42-04:00 Implement `fullCompilerVersion` Follow-up of https://gitlab.haskell.org/ghc/ghc/-/issues/18403 This MR adds `fullCompilerVersion`, a function that shares the same backend as the `--numeric-version` GHC flag, exposing a full, three-digit version datatype. - - - - - e6cf27df by Hécate at 2020-07-18T07:26:43-04:00 Add a Lint hadrian rule and an .hlint.yaml file in base/ - - - - - bcb177dd by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Allow multiple case branches to have a higher rank type As #18412 points out, it should be OK for multiple case alternatives to have a higher rank type, provided they are all the same. This patch implements that change. It sweeps away GHC.Tc.Gen.Match.tauifyMultipleBranches, and friends, replacing it with an enhanced version of fillInferResult. The basic change to fillInferResult is to permit the case in which another case alternative has already filled in the result; and in that case simply unify. It's very simple actually. See the new Note [fillInferResult] in TcMType Other refactoring: - Move all the InferResult code to one place, in GHC.Tc.Utils.TcMType (previously some of it was in Unify) - Move tcInstType and friends from TcMType to Instantiate, where it more properly belongs. (TCMType was getting very long.) - - - - - e5525a51 by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Improve typechecking of NPlusK patterns This patch (due to Richard Eisenberg) improves documentation of the wrapper returned by tcSubMult (see Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify). And, more substantially, it cleans up the multiplicity handling in the typechecking of NPlusKPat - - - - - 12f90352 by Krzysztof Gogolewski at 2020-07-18T07:26:45-04:00 Remove {-# CORE #-} pragma (part of #18048) This pragma has no effect since 2011. It was introduced for External Core, which no longer exists. Updates haddock submodule. - - - - - e504c913 by Simon Peyton Jones at 2020-07-18T07:26:45-04:00 Refactor the simplification of join binders This MR (for #18449) refactors the Simplifier's treatment of join-point binders. Specifically, it puts together, into GHC.Core.Opt.Simplify.Env.adjustJoinPointType two currently-separate ways in which we adjust the type of a join point. As the comment says: -- (adjustJoinPointType mult new_res_ty join_id) does two things: -- -- 1. Set the return type of the join_id to new_res_ty -- See Note [Return type for join points] -- -- 2. Adjust the multiplicity of arrows in join_id's type, as -- directed by 'mult'. See Note [Scaling join point arguments] I think this actually fixes a latent bug, by ensuring that the seIdSubst and seInScope have the right multiplicity on the type of join points. I did some tidying up while I was at it. No more setJoinResTy, or modifyJoinResTy: instead it's done locally in Simplify.Env.adjustJoinPointType - - - - - 49b265f0 by Chaitanya Koparkar at 2020-07-18T07:26:46-04:00 Fix minor typos in a Core.hs note - - - - - 8d59aed6 by Stefan Schulze Frielinghaus at 2020-07-18T07:26:47-04:00 GHCi: Fix isLittleEndian - - - - - c26e81d1 by Ben Gamari at 2020-07-18T07:26:47-04:00 testsuite: Mark ghci tests as fragile under unreg compiler In particular I have seen T16012 fail repeatedly under the unregisterised compiler. - - - - - 868e4523 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "AArch32 symbols only on aarch32." This reverts commit cdfeb3f24f76e8fd30452016676e56fbc827789a. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - c915ba84 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "Fix (1)" This reverts commit 7abffced01f5680efafe44f6be2733eab321b039. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 777c452a by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "better if guards." This reverts commit 3f60b94de1f460ca3f689152860b108a19ce193e. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 0dd40552 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "[linker/rtsSymbols] More linker symbols" This reverts commit 686e72253aed3880268dd6858eadd8c320f09e97. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 30caeee7 by Sylvain Henry at 2020-07-21T06:39:33-04:00 DynFlags: remove use of sdocWithDynFlags from GHC.Stg.* (#17957) * add StgPprOpts datatype * remove Outputable instances for types that need `StgPprOpts` to be pretty-printed and explicitly call type specific ppr functions * add default `panicStgPprOpts` for panic messages (when it's not convenient to thread StgPprOpts or DynFlags down to the ppr function call) - - - - - 863c544c by Mark at 2020-07-21T06:39:34-04:00 Fix a typo in existential_quantification.rst - - - - - 05910be1 by Krzysztof Gogolewski at 2020-07-21T14:47:07-04:00 Add release notes entry for #17816 [skip ci] - - - - - a6257192 by Matthew Pickering at 2020-07-21T14:47:19-04:00 Use a newtype `Code` for the return type of typed quotations (Proposal #195) There are three problems with the current API: 1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition of two type constructors. Doing so in your program involves making your own newtype and doing a lot of wrapping/unwrapping. For example, if I want to create a language which I can either run immediately or generate code from I could write the following with the new API. :: class Lang r where _int :: Int -> r Int _if :: r Bool -> r a -> r a -> r a instance Lang Identity where _int = Identity _if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f) instance Quote m => Lang (Code m) where _int = liftTyped _if cb ct cf = [|| if $$cb then $$ct else $$cf ||] 2. When doing code generation it is common to want to store code fragments in a map. When doing typed code generation, these code fragments contain a type index so it is desirable to store them in one of the parameterised map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from ``parameterized-utils``. :: compiler :: Env -> AST a -> Code Q a data AST a where ... data Ident a = ... type Env = MapF Ident (Code Q) newtype Code m a = Code (m (TExp a)) In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``. Using one of these map types currently requires creating your own newtype and constantly wrapping every quotation and unwrapping it when using a splice. Achievable, but it creates even more syntactic noise than normal metaprogramming. 3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is easier. This is a weak reason but one everyone can surely agree with. Updates text submodule. - - - - - 58235d46 by Ben Gamari at 2020-07-21T14:47:28-04:00 users-guide: Fix :rts-flag:`--copying-gc` documentation It was missing a newline. - - - - - 19e80b9a by Vladislav Zavialov at 2020-07-21T14:50:01-04:00 Accumulate Haddock comments in P (#17544, #17561, #8944) Haddock comments are, first and foremost, comments. It's very annoying to incorporate them into the grammar. We can take advantage of an important property: adding a Haddock comment does not change the parse tree in any way other than wrapping some nodes in HsDocTy and the like (and if it does, that's a bug). This patch implements the following: * Accumulate Haddock comments with their locations in the P monad. This is handled in the lexer. * After parsing, do a pass over the AST to associate Haddock comments with AST nodes using location info. * Report the leftover comments to the user as a warning (-Winvalid-haddock). - - - - - 4c719460 by David Binder at 2020-07-22T20:17:35-04:00 Fix dead link to haskell prime discussion - - - - - f2f817e4 by BinderDavid at 2020-07-22T20:17:35-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 0bf8980e by Daniel Gröber at 2020-07-22T20:18:11-04:00 Remove length field from FastString - - - - - 1010c33b by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 8336ba78 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - 7484a9a4 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 5536ed28 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 5b8902e3 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - 5976a161 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 9ddf1614 by Daniel Gröber at 2020-07-22T20:18:11-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - e9491668 by Ben Gamari at 2020-07-22T20:18:46-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 9f3ff8fd by Andreas Klebinger at 2020-07-22T20:19:22-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - 0f17b930 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - bab4ec8f by Sylvain Henry at 2020-07-22T20:19:59-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - 8ea33edb by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused sGhcWithNativeCodeGen - - - - - e079bb72 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - 735f9d6b by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - f7cc4313 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace HscTarget with Backend They both have the same role and Backend name is more explicit. Metric Decrease: T3064 Update Haddock submodule - - - - - 15ce1804 by Andreas Klebinger at 2020-07-22T20:20:34-04:00 Deprecate -fdmd-tx-dict-sel. It's behaviour is now unconditionally enabled as it's slightly beneficial. There are almost no benchmarks which benefit from disabling it, so it's not worth the keep this configurable. This fixes #18429. - - - - - ff1b7710 by Sylvain Henry at 2020-07-22T20:21:11-04:00 Add test for #18064 It has been fixed by 0effc57d48ace6b719a9f4cbeac67c95ad55010b - - - - - cfa89149 by Krzysztof Gogolewski at 2020-07-22T20:21:48-04:00 Define type Void# = (# #) (#18441) There's one backwards compatibility issue: GHC.Prim no longer exports Void#, we now manually re-export it from GHC.Exts. - - - - - 02f40b0d by Sebastian Graf at 2020-07-22T20:22:23-04:00 Add regression test for #18478 !3392 backported !2993 to GHC 8.10.2 which most probably is responsible for fixing #18478, which triggered a pattern match checker performance regression in GHC 8.10.1 as first observed in #17977. - - - - - 7f44df1e by Sylvain Henry at 2020-07-22T20:23:00-04:00 Minor refactoring of Unit display * for consistency, try to always use UnitPprInfo to display units to users * remove some uses of `unitPackageIdString` as it doesn't show the component name and it uses String - - - - - dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - cdd0ff16 by Tamar Christina at 2020-07-24T18:12:23-04:00 winio: restore console cp on exit - - - - - c1f4f81d by Tamar Christina at 2020-07-24T18:13:00-04:00 winio: change memory allocation strategy and fix double free errors. - - - - - ba205046 by Simon Peyton Jones at 2020-07-24T18:13:35-04:00 Care with occCheckExpand in kind of occurrences Issue #18451 showed that we could get an infinite type, through over-use of occCheckExpand in the kind of an /occurrence/ of a type variable. See Note [Occurrence checking: look inside kinds] in GHC.Core.Type This patch fixes the problem by making occCheckExpand less eager to expand synonyms in kinds. It also improves pretty printing of kinds, by *not* suppressing the kind on a tyvar-binder like (a :: Const Type b) where type Const p q = p. Even though the kind of 'a' is Type, we don't want to suppress the kind ascription. Example: the error message for polykinds/T18451{a,b}. See GHC.Core.TyCo.Ppr Note [Suppressing * kinds]. - - - - - 02133353 by Zubin Duggal at 2020-07-25T00:44:30-04:00 Simplify XRec definition Change `Located X` usage to `XRec pass X` This increases the scope of the LPat experiment to almost all of GHC. Introduce UnXRec and MapXRec classes Fixes #17587 and #18408 Updates haddock submodule Co-authored-by: Philipp Krüger <philipp.krueger1 at gmail.com> - - - - - e443846b by Sylvain Henry at 2020-07-25T00:45:07-04:00 DynFlags: store printer in TraceBinIfaceReading We don't need to pass the whole DynFlags, just pass the logging function, if any. - - - - - 15b2b44f by Sylvain Henry at 2020-07-25T00:45:08-04:00 Rename GHC.Driver.Ways into GHC.Platform.Ways - - - - - 342a01af by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add GHC.Platform.Profile - - - - - 6333d739 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Put PlatformConstants into Platform - - - - - 9dfeca6c by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove platform constant wrappers Platform constant wrappers took a DynFlags parameter, hence implicitly used the target platform constants. We removed them to allow support for several platforms at once (#14335) and to avoid having to pass the full DynFlags to every function (#17957). Metric Decrease: T4801 - - - - - 73145d57 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove dead code in utils/derivConstants - - - - - 7721b923 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Move GHC.Platform into the compiler Previously it was in ghc-boot so that ghc-pkg could use it. However it wasn't necessary because ghc-pkg only uses a subset of it: reading target arch and OS from the settings file. This is now done via GHC.Platform.ArchOS (was called PlatformMini before). - - - - - 459afeb5 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Fix build systems - - - - - 9e2930c3 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Bump CountParserDeps - - - - - 6e2db34b by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add accessors to ArchOS - - - - - fc0f6fbc by Stefan Schulze Frielinghaus at 2020-07-25T00:45:45-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 - - - - - a7c4439a by Matthias Andreas Benkard at 2020-07-26T13:23:24-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. - - - - - da7269a4 by Ben Gamari at 2020-07-26T13:23:59-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. - - - - - f153a1d0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Update win32 output for parseTree - - - - - e91672f0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. - - - - - 9cbfe086 by Ben Gamari at 2020-07-26T13:23:59-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. - - - - - 8236925f by Tamar Christina at 2020-07-26T13:24:35-04:00 winio: remove dead argument to stg_newIOPortzh - - - - - ce0a1d67 by Tamar Christina at 2020-07-26T13:25:11-04:00 winio: fix detection of tty terminals - - - - - 52685cf7 by Tamar Christina at 2020-07-26T13:25:48-04:00 winio: update codeowners - - - - - aee45d9e by Vladislav Zavialov at 2020-07-27T07:06:56-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. - - - - - 667ab69e by leiftw at 2020-07-27T07:07:32-04:00 fix typo referring to non-existent `-ohidir` flag, should be `-hidir` I think - - - - - 6ff89c17 by Vladislav Zavialov at 2020-07-27T07:08:07-04:00 Refactor the parser a little * Create a dedicated production for type operators * Create a dedicated type for the UNPACK pragma * Remove an outdated part of Note [Parsing data constructors is hard] - - - - - aa054d32 by Ben Gamari at 2020-07-27T20:09:07-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. - - - - - 6da73bbf by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Add minimal test for #12492 - - - - - 47680cb7 by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Use allocate, not ALLOC_PRIM_P for unpackClosure# ALLOC_PRIM_P fails for large closures, by directly using allocate we can handle closures which are larger than the block size. Fixes #12492 - - - - - 3d345c96 by Simon Peyton Jones at 2020-07-27T20:10:19-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 - - - - - 57aca6bb by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. - - - - - 0a815cea by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. - - - - - 0bd60059 by Simon Peyton Jones at 2020-07-28T02:01:49-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 - - - - - 6ee07b49 by Sylvain Henry at 2020-07-28T02:02:27-04:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - f305bbfd by Peter Trommler at 2020-07-28T02:03:02-04:00 config: Fix Haskell platform constructor w/ params Fixes #18505 - - - - - 318bb17c by Oleg Grenrus at 2020-07-28T20:54:13-04:00 Fix typo in haddock Spotted by `vilpan` on `#haskell` - - - - - 39c89862 by Sergei Trofimovich at 2020-07-28T20:54:50-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b9a880fc by Felix Wiemuth at 2020-07-29T15:06:35-04:00 Fix typo - - - - - c59064b0 by Brandon Chinn at 2020-07-29T15:07:11-04:00 Add regression test for #16341 - - - - - a61411ca by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass dit_rep_tc_args to dsm_stock_gen_fn - - - - - a26498da by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass tc_args to gen_fn - - - - - 44b11bad by Brandon Chinn at 2020-07-29T15:07:11-04:00 Filter out unreachable constructors when deriving stock instances (#16431) - - - - - bbc51916 by Simon Peyton Jones at 2020-07-29T15:07:47-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 - - - - - e3db4b4c by Peter Trommler at 2020-07-29T15:08:22-04:00 configure: Fix build system on ARM - - - - - 96c31ea1 by Sylvain Henry at 2020-07-29T15:09:02-04:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - e1dc3d7b by Krzysztof Gogolewski at 2020-07-29T15:09:39-04:00 Fix validation errors (#18510) Test T2632 is a stage1 test that failed because of the Q => Quote change. The remaining tests did not use quotation and failed when the path contained a space. - - - - - 6c68a842 by John Ericson at 2020-07-30T07:11:02-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. - - - - - 502de556 by cgibbard at 2020-07-30T07:11:02-04:00 Add haddock comment for unfilteredEdges and move the note about drop_hs_boot_nodes into it. - - - - - 01c948eb by Ryan Scott at 2020-07-30T07:11:37-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. - - - - - d47324ce by Ryan Scott at 2020-07-30T07:12:16-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. - - - - - ebe2cf45 by Simon Peyton Jones at 2020-07-30T07:12:52-04:00 Remove an incorrect WARN in extendLocalRdrEnv I noticed this warning going off, and discovered that it's really fine. This small patch removes the warning, and docments what is going on. - - - - - 9f71f697 by Simon Peyton Jones at 2020-07-30T07:13:27-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d - - - - - 7c274cd5 by Sylvain Henry at 2020-07-30T22:54:48-04:00 Fix minimal imports dump for boot files (fix #18497) - - - - - 175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00 DynFlags: don't use sdocWithDynFlags in datacon ppr We don't need to use `sdocWithDynFlags` to know whether we should display linear types for datacon types, we already have `sdocLinearTypes` field in `SDocContext`. Moreover we want to remove `sdocWithDynFlags` (#10143, #17957)). - - - - - 380638a3 by Sylvain Henry at 2020-07-30T22:56:03-04:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - 56a7c193 by Sylvain Henry at 2020-07-31T19:32:09+02:00 Refactor CLabel pretty-printing Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove (#10143, #17957). It uses it to query the backend and the platform. This patch exposes Clabel ppr functions specialised for each backend so that backend code can directly use them. - - - - - 3b15dc3c by Sylvain Henry at 2020-07-31T19:32:09+02:00 DynFlags: don't use sdocWithDynFlags in GHC.CmmToAsm.Dwarf.Types - - - - - e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00 Test case for #17652 The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec - - - - - 22641742 by Ryan Scott at 2020-08-02T16:44:11-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. - - - - - f2d1accf by Leon Schoorl at 2020-08-02T16:44:47-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 - - - - - 947206f4 by Niklas Hambüchen at 2020-08-03T07:52:33+02:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. - - - - - ef2ae81a by Alex Biehl at 2020-08-03T07:52:33+02:00 Hardcode RTS includes to cope with unregistered builds - - - - - d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 5e12cd17 by Krzysztof Gogolewski at 2020-08-05T04:00:04-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. - - - - - 2bff2f87 by Ben Gamari at 2020-08-05T04:00:39-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. - - - - - 53ce0db5 by Ben Gamari at 2020-08-05T04:00:39-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. - - - - - eb7013c3 by Hécate at 2020-08-05T04:01:15-04:00 Remove all the unnecessary LANGUAGE pragmas - - - - - fbcb886d by Ryan Scott at 2020-08-05T04:01:51-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. - - - - - 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - c73ce5fd by Sebastian Graf at 2020-09-01T10:31:07+02:00 Add Pretty.zeroWidth{F,P}Text, use it in Cmm Ppr This is ultimately so that we can drop the length field of `FastString`. The Cmm pretty printer doesn't look at the width anyway, so eagerly computing it is redundant. There are a multitude of occurrences of `text` in `compiler/GHC/Cmm`, but they mostly rewrite to `ptext` anyway, where computing the length isn't particularly expensive, so I refrained from changing these occurrences to `zeroWidthText` for the time being. >From the three proposed approaches in https://gitlab.haskell.org/ghc/ghc/issues/17069#note_259689 this one seemed like the simplest and least intrusive; plus, there is already precedent with `Pretty.zeroWidthText`. Fixes #17069. - - - - - 17 changed files: - + .git-ignore-revs - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - Makefile - aclocal.m4 - compiler/GHC.hs - + compiler/GHC/Builtin/Names.hs - + compiler/GHC/Builtin/Names/TH.hs - + compiler/GHC/Builtin/PrimOps.hs - + compiler/GHC/Builtin/PrimOps.hs-boot - + compiler/GHC/Builtin/RebindableNames.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb415b18baf61b8f7aeec4a01652de6154f08850...c73ce5fd531e9e59df152df09994f533edd46ea9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/fb415b18baf61b8f7aeec4a01652de6154f08850...c73ce5fd531e9e59df152df09994f533edd46ea9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 09:39:31 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 01 Sep 2020 05:39:31 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: base: Better error message on invalid getSystemTimerManager call Message-ID: <5f4e16d3d4bab_80b3f846a4a01401012261d@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 435b7933 by Sylvain Henry at 2020-09-01T05:39:22-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 8f81b58d by Sylvain Henry at 2020-09-01T05:39:22-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - 30 changed files: - .gitignore - aclocal.m4 - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Debug.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/CostCentre.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/SrcLoc.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/Module/Name.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1fd44bad93ff54b9e956e4041fd56a83fc4a776...8f81b58d9dd4f7999ade954eb95c6fcf680b50a7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b1fd44bad93ff54b9e956e4041fd56a83fc4a776...8f81b58d9dd4f7999ade954eb95c6fcf680b50a7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 09:57:17 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Sep 2020 05:57:17 -0400 Subject: [Git][ghc/ghc][wip/ftext-no-length] Add Pretty.zeroWidth{F,P}Text, use it in Cmm Ppr Message-ID: <5f4e1afd11b94_80bd3253681012584c@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/ftext-no-length at Glasgow Haskell Compiler / GHC Commits: 0300613c by Sebastian Graf at 2020-09-01T11:57:07+02:00 Add Pretty.zeroWidth{F,P}Text, use it in Cmm Ppr This is ultimately so that we can drop the length field of `FastString`. The Cmm pretty printer doesn't look at the width anyway, so eagerly computing it is redundant. There are a multitude of occurrences of `text` in `compiler/GHC/Cmm`, but they mostly rewrite to `ptext` anyway, where computing the length isn't particularly expensive, so I refrained from changing these occurrences to `zeroWidthText` for the time being. >From the three proposed approaches in https://gitlab.haskell.org/ghc/ghc/issues/17069#note_259689 this one seemed like the simplest and least intrusive; plus, there is already precedent with `Pretty.zeroWidthText`. Fixes #17069. - - - - - 4 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Ppr.hs - compiler/GHC/Utils/Outputable.hs - compiler/GHC/Utils/Ppr.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -1248,7 +1248,7 @@ pprCLabel_NCG platform lbl = getPprStyle $ \sty -> <> case l of AsmTempLabel u -> pprUniqueAlways u LocalBlockLabel u -> pprUniqueAlways u _other -> pprCLabel_NCG platform l - <> ftext suf + <> zeroWidthFText suf DynamicLinkerLabel info lbl -> pprDynamicLinkerAsmLabel platform info lbl @@ -1274,7 +1274,7 @@ pprCLabel_NCG platform lbl = getPprStyle $ \sty -> , OSMinGW32 <- platformOS platform -> -- In asm mode, we need to put the suffix on a stdcall ForeignLabel. -- (The C compiler does this itself). - maybe_underscore $ ftext fs <> char '@' <> int sz + maybe_underscore $ zeroWidthFText fs <> char '@' <> int sz _ | asmStyle sty -> maybe_underscore $ pprCLabel_common platform lbl | otherwise -> pprCLabel_common platform lbl @@ -1302,13 +1302,13 @@ pprCLabel_common platform = \case -- until that gets resolved we'll just force them to start -- with a letter so the label will be legal assembly code. - (CmmLabel _ _ str CmmCode) -> ftext str - (CmmLabel _ _ str CmmData) -> ftext str - (CmmLabel _ _ str CmmPrimCall) -> ftext str + (CmmLabel _ _ str CmmCode) -> zeroWidthFText str + (CmmLabel _ _ str CmmData) -> zeroWidthFText str + (CmmLabel _ _ str CmmPrimCall) -> zeroWidthFText str (LocalBlockLabel u) -> tempLabelPrefixOrUnderscore platform <> text "blk_" <> pprUniqueAlways u - (RtsLabel (RtsApFast str)) -> ftext str <> text "_fast" + (RtsLabel (RtsApFast str)) -> zeroWidthFText str <> text "_fast" (RtsLabel (RtsSelectorInfoTable upd_reqd offset)) -> hcat [text "stg_sel_", text (show offset), @@ -1338,17 +1338,17 @@ pprCLabel_common platform = \case else (sLit "_noupd_entry")) ] - (CmmLabel _ _ fs CmmInfo) -> ftext fs <> text "_info" - (CmmLabel _ _ fs CmmEntry) -> ftext fs <> text "_entry" - (CmmLabel _ _ fs CmmRetInfo) -> ftext fs <> text "_info" - (CmmLabel _ _ fs CmmRet) -> ftext fs <> text "_ret" - (CmmLabel _ _ fs CmmClosure) -> ftext fs <> text "_closure" + (CmmLabel _ _ fs CmmInfo) -> zeroWidthFText fs <> text "_info" + (CmmLabel _ _ fs CmmEntry) -> zeroWidthFText fs <> text "_entry" + (CmmLabel _ _ fs CmmRetInfo) -> zeroWidthFText fs <> text "_info" + (CmmLabel _ _ fs CmmRet) -> zeroWidthFText fs <> text "_ret" + (CmmLabel _ _ fs CmmClosure) -> zeroWidthFText fs <> text "_closure" (RtsLabel (RtsPrimOp primop)) -> text "stg_" <> ppr primop (RtsLabel (RtsSlowFastTickyCtr pat)) -> text "SLOW_CALL_fast_" <> text pat <> ptext (sLit "_ctr") - (ForeignLabel str _ _ _) -> ftext str + (ForeignLabel str _ _ _) -> zeroWidthFText str (IdLabel name _cafs flavor) -> internalNamePrefix platform name <> ppr name <> ppIdFlavor flavor ===================================== compiler/GHC/Cmm/Ppr.hs ===================================== @@ -194,7 +194,8 @@ pprNode platform node = pp_node <+> pp_debug <+> ppUnlessOption sdocSuppressTicks (text "//" <+> ppr tscope) -- // text - CmmComment s -> text "//" <+> ftext s + -- See Note [zeroWidthFText in Cmm] + CmmComment s -> text "//" <+> zeroWidthFText s -- //tick bla<...> CmmTick t -> ppUnlessOption sdocSuppressTicks @@ -308,3 +309,11 @@ pprNode platform node = pp_node <+> pp_debug commafy :: [SDoc] -> SDoc commafy xs = hsep $ punctuate comma xs + +{- Note [zeroWidthFText in Cmm] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In an effort to remove the length field of 'FastString' (!1675), we decided to +use 'zeroWidthFText' when pretty-printing Cmm, even though the involved strings +are not actually of zero width. That works because the Cmm pretty-printer +assumes an infinite ribbon anyway, so will never insert line breaks itself. +-} ===================================== compiler/GHC/Utils/Outputable.hs ===================================== @@ -25,6 +25,7 @@ module GHC.Utils.Outputable ( empty, isEmpty, nest, char, text, ftext, ptext, ztext, + zeroWidthText, zeroWidthFText, zeroWidthPText, int, intWithCommas, integer, word, float, double, rational, doublePrec, parens, cparen, brackets, braces, quotes, quote, doubleQuotes, angleBrackets, @@ -611,6 +612,14 @@ word n = sdocOption sdocHexWordLiterals $ \case True -> docToSDoc $ Pretty.hex n False -> docToSDoc $ Pretty.integer n +zeroWidthText :: String -> SDoc +zeroWidthFText :: FastString -> SDoc +zeroWidthPText :: PtrString -> SDoc + +zeroWidthText s = docToSDoc $ Pretty.zeroWidthText s +zeroWidthFText s = docToSDoc $ Pretty.zeroWidthFText s +zeroWidthPText s = docToSDoc $ Pretty.zeroWidthPText s + -- | @doublePrec p n@ shows a floating point number @n@ with @p@ -- digits of precision after the decimal point. doublePrec :: Int -> Double -> SDoc ===================================== compiler/GHC/Utils/Ppr.hs ===================================== @@ -71,7 +71,8 @@ module GHC.Utils.Ppr ( -- * Constructing documents -- ** Converting values into documents - char, text, ftext, ptext, ztext, sizedText, zeroWidthText, + char, text, ftext, ptext, ztext, sizedText, + zeroWidthText, zeroWidthFText, zeroWidthPText, int, integer, float, double, rational, hex, -- ** Simple derived documents @@ -309,12 +310,38 @@ text s = textBeside_ (Str s) (length s) Empty forall p n. text (unpackNBytes# p n) = ptext (PtrString (Ptr p) (I# n)) #-} +-- | Some text, but without any width. Use for non-printing text +-- such as a HTML or Latex tags. +-- +-- Also useful if you plan to have an infinite ribbon anyway. +-- Note [zeroWidthFText in Cmm] in "GHC.Cmm.Ppr" describes that use case. +zeroWidthText :: String -> Doc +zeroWidthText = sizedText 0 +{-# NOINLINE [0] zeroWidthText #-} + +{-# RULES "zeroWidthText/str" + forall a. zeroWidthText (unpackCString# a) = zeroWidthPText (mkPtrString# a) + #-} +{-# RULES "zeroWidthText/unpackNBytes#" + forall p n. zeroWidthText (unpackNBytes# p n) = zeroWidthPText (PtrString (Ptr p) (I# n)) + #-} + ftext :: FastString -> Doc ftext s = textBeside_ (PStr s) (lengthFS s) Empty +-- | Like 'zeroWidthText', but for 'FastString'. +-- +-- See also Note [zeroWidthFText in Cmm] in "GHC.Cmm.Ppr". +zeroWidthFText :: FastString -> Doc +zeroWidthFText s = textBeside_ (PStr s) 0 Empty + ptext :: PtrString -> Doc ptext s = textBeside_ (LStr s) (lengthPS s) Empty +-- | Like 'zeroWidthText', but for 'PtrString'. +zeroWidthPText :: PtrString -> Doc +zeroWidthPText s = textBeside_ (LStr s) 0 Empty + ztext :: FastZString -> Doc ztext s = textBeside_ (ZStr s) (lengthFZS s) Empty @@ -322,11 +349,6 @@ ztext s = textBeside_ (ZStr s) (lengthFZS s) Empty sizedText :: Int -> String -> Doc sizedText l s = textBeside_ (Str s) l Empty --- | Some text, but without any width. Use for non-printing text --- such as a HTML or Latex tags -zeroWidthText :: String -> Doc -zeroWidthText = sizedText 0 - -- | The empty document, with no height and no width. -- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere -- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0300613c4f361e655c1c6ac7da3cefea3c6089b6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0300613c4f361e655c1c6ac7da3cefea3c6089b6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 11:45:58 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 01 Sep 2020 07:45:58 -0400 Subject: [Git][ghc/ghc][wip/wire-in-constraint-tuples] Wire in constraint tuples Message-ID: <5f4e34761bdad_80b3f84901e9368101330b0@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/wire-in-constraint-tuples at Glasgow Haskell Compiler / GHC Commits: f4150afd by Ryan Scott at 2020-09-01T07:45:19-04:00 Wire in constraint tuples This wires in the definitions of the constraint tuple classes. The key changes are in: * `GHC.Builtin.Types`, where the `mk_ctuple` function is used to define constraint tuple type constructors, data constructors, and superclass selector functions, and * `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for constraint tuple type and data constructors, we now must wire in the superclass selector functions. Luckily, this proves to be not that challenging. See the newly added comments. Fixes #18635. ------------------------- Metric Decrease: T10421 T12150 T12227 T12234 T12425 T13056 T13253-spj T18282 T18304 T5321FD T5321Fun T5837 T9961 ------------------------- - - - - - 5 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/HsType.hs Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -80,9 +80,10 @@ module GHC.Builtin.Types ( unboxedTupleKind, unboxedSumKind, -- ** Constraint tuples - cTupleTyConName, cTupleTyConNames, isCTupleTyConName, + cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName, cTupleTyConNameArity_maybe, - cTupleDataConName, cTupleDataConNames, + cTupleDataCon, cTupleDataConName, cTupleDataConNames, + cTupleSelId, cTupleSelIdName, -- * Any anyTyCon, anyTy, anyTypeOfKind, @@ -174,10 +175,9 @@ import GHC.Core.Class ( Class, mkClass ) import GHC.Types.Name.Reader import GHC.Types.Name as Name import GHC.Types.Name.Env ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF ) -import GHC.Types.Name.Set ( NameSet, mkNameSet, elemNameSet ) import GHC.Types.Basic import GHC.Types.ForeignCall -import GHC.Types.SrcLoc ( noSrcSpan ) +import GHC.Types.Unique.Set import Data.Array import GHC.Data.FastString import GHC.Data.BooleanFormula ( mkAnd ) @@ -723,20 +723,23 @@ Note [How tuples work] See also Note [Known-key names] in GHC.Builtin.Names but no actual declaration and no info table * ConstraintTuples - - Are known-key rather than wired-in. Reason: it's awkward to - have all the superclass selectors wired-in. + - A wired-in type. - Declared as classes in GHC.Classes, e.g. class (c1,c2) => (c1,c2) - Given constraints: the superclasses automatically become available - Wanted constraints: there is a built-in instance instance (c1,c2) => (c1,c2) - See GHC.Tc.Solver.Interact.matchCTuple + See GHC.Tc.Instance.Class.matchCTuple - Currently just go up to 62; beyond that you have to use manual nesting - Their OccNames look like (%,,,%), so they can easily be distinguished from term tuples. But (following Haskell) we pretty-print saturated constraint tuples with round parens; see BasicTypes.tupleParens. + - Unlike BoxedTuples and UnboxedTuples, which only wire + in type constructors and data constructors, ConstraintTuples also wire in + superclass selector functions. For instance, $p1(%,%) and $p2(%,%) are + the selectors for the binary constraint tuple. * In quite a lot of places things are restricted just to BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish @@ -914,26 +917,26 @@ mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)" commas :: Arity -> String commas ar = take (ar-1) (repeat ',') +cTupleTyCon :: Arity -> TyCon +cTupleTyCon i + | i > mAX_CTUPLE_SIZE = fstOf3 (mk_ctuple i) -- Build one specially + | otherwise = fstOf3 (cTupleArr ! i) + cTupleTyConName :: Arity -> Name -cTupleTyConName arity - = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES - (mkCTupleOcc tcName arity) noSrcSpan +cTupleTyConName a = tyConName (cTupleTyCon a) cTupleTyConNames :: [Name] cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) -cTupleTyConNameSet :: NameSet -cTupleTyConNameSet = mkNameSet cTupleTyConNames +cTupleTyConKeys :: UniqSet Unique +cTupleTyConKeys = mkUniqSet $ map getUnique cTupleTyConNames isCTupleTyConName :: Name -> Bool --- Use Type.isCTupleClass where possible isCTupleTyConName n = ASSERT2( isExternalName n, ppr n ) - nameModule n == gHC_CLASSES - && n `elemNameSet` cTupleTyConNameSet + getUnique n `elementOfUniqSet` cTupleTyConKeys -- | If the given name is that of a constraint tuple, return its arity. --- Note that this is inefficient. cTupleTyConNameArity_maybe :: Name -> Maybe Arity cTupleTyConNameArity_maybe n | not (isCTupleTyConName n) = Nothing @@ -943,14 +946,46 @@ cTupleTyConNameArity_maybe n -- case, we have to adjust accordingly our calculated arity. adjustArity a = if a > 0 then a + 1 else a +cTupleDataCon :: Arity -> DataCon +cTupleDataCon i + | i > mAX_CTUPLE_SIZE = sndOf3 (mk_ctuple i) -- Build one specially + | otherwise = sndOf3 (cTupleArr ! i) + cTupleDataConName :: Arity -> Name -cTupleDataConName arity - = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES - (mkCTupleOcc dataName arity) noSrcSpan +cTupleDataConName i = dataConName (cTupleDataCon i) cTupleDataConNames :: [Name] cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE]) +cTupleSelId :: ConTag -- Superclass position + -> Arity -- Arity + -> Id +cTupleSelId sc_pos arity + | sc_pos > arity + = panic ("cTupleSelId: index out of bounds: superclass position: " + ++ show sc_pos ++ " > arity " ++ show arity) + + | sc_pos <= 0 + = panic ("cTupleSelId: Superclass positions start from 1. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity < 2 + = panic ("cTupleSelId: Arity starts from 2. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity > mAX_CTUPLE_SIZE + = thdOf3 (mk_ctuple arity) ! (sc_pos - 1) -- Build one specially + + | otherwise + = thdOf3 (cTupleArr ! arity) ! (sc_pos - 1) + +cTupleSelIdName :: ConTag -- Superclass position + -> Arity -- Arity + -> Name +cTupleSelIdName sc_pos arity = idName (cTupleSelId sc_pos arity) + tupleTyCon :: Boxity -> Arity -> TyCon tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i) -- Build one specially tupleTyCon Boxed i = fst (boxedTupleArr ! i) @@ -976,6 +1011,20 @@ boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon) boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]] unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]] +-- | Cached type constructors, data constructors, and superclass selectors for +-- constraint tuples. The outer array is indexed by the arity of the constraint +-- tuple and the inner array is indexed by the superclass position. +cTupleArr :: Array Int (TyCon, DataCon, Array Int Id) +cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZE]] + -- Although GHC does not make use of unary constraint tuples + -- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType), + -- this array creates one anyway. This is primarily motivated by the fact + -- that (1) the indices of an Array must be contiguous, and (2) we would like + -- the index of a constraint tuple in this Array to correspond to its Arity. + -- We could envision skipping over the unary constraint tuple and having index + -- 1 correspond to a 2-constraint tuple (and so on), but that's more + -- complicated than it's worth. + -- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed -- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type -- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep @@ -1040,6 +1089,45 @@ mk_tuple Unboxed arity = (tycon, tuple_con) tc_uniq = mkTupleTyConUnique boxity arity dc_uniq = mkTupleDataConUnique boxity arity +mk_ctuple :: Arity -> (TyCon, DataCon, Array ConTagZ Id) +mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr) + where + tycon = mkClassTyCon tc_name binders roles + rhs klass + (mkPrelTyConRepName tc_name) + + klass = mk_ctuple_class tycon sc_theta sc_sel_ids + tuple_con = pcDataConW dc_name tvs (map unrestricted sc_theta) tycon + + binders = mkTemplateAnonTyConBinders (replicate arity constraintKind) + roles = replicate arity Nominal + rhs = TupleTyCon{data_con = tuple_con, tup_sort = ConstraintTuple} + + modu = gHC_CLASSES + tc_name = mkWiredInName modu (mkCTupleOcc tcName arity) tc_uniq + (ATyCon tycon) BuiltInSyntax + dc_name = mkWiredInName modu (mkCTupleOcc dataName arity) dc_uniq + (AConLike (RealDataCon tuple_con)) BuiltInSyntax + tc_uniq = mkCTupleTyConUnique arity + dc_uniq = mkCTupleDataConUnique arity + + tvs = binderVars binders + sc_theta = map mkTyVarTy tvs + sc_sel_ids = [mk_sc_sel_id sc_pos | sc_pos <- [0..arity-1]] + sc_sel_ids_arr = listArray (0,arity-1) sc_sel_ids + + mk_sc_sel_id sc_pos = + let sc_sel_id_uniq = mkCTupleSelIdUnique sc_pos arity + sc_sel_id_occ = mkCTupleOcc tcName arity + sc_sel_id_name = mkWiredInIdName + gHC_CLASSES + (occNameFS (mkSuperDictSelOcc sc_pos sc_sel_id_occ)) + sc_sel_id_uniq + sc_sel_id + sc_sel_id = mkDictSelId sc_sel_id_name klass + + in sc_sel_id + unitTyCon :: TyCon unitTyCon = tupleTyCon Boxed 0 @@ -1248,7 +1336,10 @@ mk_class tycon sc_pred sc_sel_id = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon - +mk_ctuple_class :: TyCon -> ThetaType -> [Id] -> Class +mk_ctuple_class tycon sc_theta sc_sel_ids + = mkClass (tyConName tycon) (tyConTyVars tycon) [] sc_theta sc_sel_ids + [] [] (mkAnd []) tycon {- ********************************************************************* * * ===================================== compiler/GHC/Builtin/Types.hs-boot ===================================== @@ -64,8 +64,10 @@ promotedTupleDataCon :: Boxity -> Arity -> TyCon tupleDataCon :: Boxity -> Arity -> DataCon tupleTyCon :: Boxity -> Arity -> TyCon +cTupleDataCon :: Arity -> DataCon cTupleDataConName :: Arity -> Name cTupleTyConName :: Arity -> Name +cTupleSelIdName :: ConTag -> Arity -> Name sumDataCon :: ConTag -> Arity -> DataCon sumTyCon :: Arity -> TyCon ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -22,6 +22,7 @@ module GHC.Builtin.Uniques -- *** Constraint , mkCTupleTyConUnique , mkCTupleDataConUnique + , mkCTupleSelIdUnique -- ** Making built-in uniques , mkAlphaTyVarUnique @@ -79,8 +80,9 @@ knownUniqueName u = '5' -> Just $ getTupleTyConName Unboxed n '7' -> Just $ getTupleDataConName Boxed n '8' -> Just $ getTupleDataConName Unboxed n + 'j' -> Just $ getCTupleSelIdName n 'k' -> Just $ getCTupleTyConName n - 'm' -> Just $ getCTupleDataConUnique n + 'm' -> Just $ getCTupleDataConName n _ -> Nothing where (tag, n) = unpkUnique u @@ -158,6 +160,21 @@ getUnboxedSumName n -------------------------------------------------- -- Constraint tuples +-- +-- Constraint tuples, like boxed and unboxed tuples, have their type and data +-- constructor Uniques wired in +-- (see Note [Uniques for tuple type and data constructors]). In addition, the +-- superclass selectors for each constraint tuple have wired-in Uniques. A +-- constraint tuple of arity n has n different selectors (e.g., the binary +-- constraint tuple has selectors $p1(%,%) and $p2(%,%)). +-- +-- The encoding of these selectors' Uniques takes somewhat resembles the +-- encoding for unboxed sums (see above). The integral part of the Unique +-- is broken up into bitfields for the arity and the position of the +-- superclass. Given a selector for a constraint tuple with arity n +-- (zero-based) and position k (where 1 <= k <= n), its Unique will look like: +-- +-- 00000000 nnnnnnnn kkkkkkkk mkCTupleTyConUnique :: Arity -> Unique mkCTupleTyConUnique a = mkUnique 'k' (2*a) @@ -165,6 +182,13 @@ mkCTupleTyConUnique a = mkUnique 'k' (2*a) mkCTupleDataConUnique :: Arity -> Unique mkCTupleDataConUnique a = mkUnique 'm' (3*a) +mkCTupleSelIdUnique :: ConTagZ -> Arity -> Unique +mkCTupleSelIdUnique sc_pos arity + | sc_pos >= arity + = panic ("mkCTupleSelIdUnique: " ++ show sc_pos ++ " >= " ++ show arity) + | otherwise + = mkUnique 'j' (arity `shiftL` 8 + sc_pos) + getCTupleTyConName :: Int -> Name getCTupleTyConName n = case n `divMod` 2 of @@ -172,14 +196,20 @@ getCTupleTyConName n = (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity _ -> panic "getCTupleTyConName: impossible" -getCTupleDataConUnique :: Int -> Name -getCTupleDataConUnique n = +getCTupleDataConName :: Int -> Name +getCTupleDataConName n = case n `divMod` 3 of (arity, 0) -> cTupleDataConName arity - (_arity, 1) -> panic "getCTupleDataConName: no worker" + (arity, 1) -> getName $ dataConWrapId $ cTupleDataCon arity (arity, 2) -> mkPrelTyConRepName $ cTupleDataConName arity _ -> panic "getCTupleDataConName: impossible" +getCTupleSelIdName :: Int -> Name +getCTupleSelIdName n = cTupleSelIdName (sc_pos + 1) arity + where + arity = n `shiftR` 8 + sc_pos = n .&. 0xff + -------------------------------------------------- -- Normal tuples @@ -230,6 +260,7 @@ Allocation of unique supply characters: d desugarer f AbsC flattener g SimplStg + j constraint tuple superclass selectors k constraint tuple tycons m constraint tuple datacons n Native codegen ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1204,10 +1204,9 @@ tcTupleTyCon :: Bool -- True <=> typechecking a *type* (vs. an expr) -> IfL TyCon tcTupleTyCon in_type sort arity = case sort of - ConstraintTuple -> do { thing <- tcIfaceGlobal (cTupleTyConName arity) - ; return (tyThingTyCon thing) } - BoxedTuple -> return (tupleTyCon Boxed arity) - UnboxedTuple -> return (tupleTyCon Unboxed arity') + ConstraintTuple -> return (cTupleTyCon arity) + BoxedTuple -> return (tupleTyCon Boxed arity) + UnboxedTuple -> return (tupleTyCon Unboxed arity') where arity' | in_type = arity `div` 2 | otherwise = arity -- in expressions, we only have term args ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1269,8 +1269,8 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do | arity > mAX_CTUPLE_SIZE -> failWith (bigConstraintTuple arity) | otherwise - -> do tycon <- tcLookupTyCon (cTupleTyConName arity) - check_expected_kind (mkTyConApp tycon tau_tys) constraintKind + -> let tycon = cTupleTyCon arity in + check_expected_kind (mkTyConApp tycon tau_tys) constraintKind BoxedTuple -> do let tycon = tupleTyCon Boxed arity checkWiredInTyCon tycon View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f4150afdeef05bb94b6c0c3ffd632062b40495ab -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f4150afdeef05bb94b6c0c3ffd632062b40495ab You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 13:01:54 2020 From: gitlab at gitlab.haskell.org (Vilem-Benjamin Liepelt) Date: Tue, 01 Sep 2020 09:01:54 -0400 Subject: [Git][ghc/ghc][wip/buggymcbugfix/insertArray] Make insert + update return dirty arrays Message-ID: <5f4e464228ab8_80b1128083c10150357@gitlab.haskell.org.mail> Vilem-Benjamin Liepelt pushed to branch wip/buggymcbugfix/insertArray at Glasgow Haskell Compiler / GHC Commits: fb9fc1ac by buggymcbugfix at 2020-09-01T15:00:56+02:00 Make insert + update return dirty arrays - - - - - 1 changed file: - rts/PrimOps.cmm Changes: ===================================== rts/PrimOps.cmm ===================================== @@ -596,7 +596,7 @@ stg_insertSmallArrayzh( gcptr src, W_ idx, gcptr elemt ) ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0); - SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN_info, CCCS); + SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info, CCCS); StgSmallMutArrPtrs_ptrs(dst) = n; dst_p = dst + SIZEOF_StgSmallMutArrPtrs; @@ -621,7 +621,7 @@ stg_updateSmallArrayzh( gcptr src, W_ idx, gcptr elemt ) ("ptr" dst) = ccall allocate(MyCapability() "ptr", words); TICK_ALLOC_PRIM(SIZEOF_StgSmallMutArrPtrs, WDS(n), 0); - SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_CLEAN_info, CCCS); + SET_HDR(dst, stg_SMALL_MUT_ARR_PTRS_FROZEN_DIRTY_info, CCCS); StgSmallMutArrPtrs_ptrs(dst) = n; dst_p = dst + SIZEOF_StgSmallMutArrPtrs; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb9fc1acf8b848bcbb3fa39fa4252a716912b9ee -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb9fc1acf8b848bcbb3fa39fa4252a716912b9ee You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 13:05:21 2020 From: gitlab at gitlab.haskell.org (Vilem-Benjamin Liepelt) Date: Tue, 01 Sep 2020 09:05:21 -0400 Subject: [Git][ghc/ghc][wip/buggymcbugfix/arrayOf-primop] 3 commits: Syntax fix Message-ID: <5f4e4711e34ae_80b3f84929d4c4c10150746@gitlab.haskell.org.mail> Vilem-Benjamin Liepelt pushed to branch wip/buggymcbugfix/arrayOf-primop at Glasgow Haskell Compiler / GHC Commits: 7041494a by buggymcbugfix at 2020-09-01T15:03:58+02:00 Syntax fix - - - - - 5ffc53b6 by buggymcbugfix at 2020-09-01T15:03:58+02:00 Point to some useful background information - - - - - 6c271b32 by buggymcbugfix at 2020-09-01T15:04:53+02:00 Implement `arrayOf#` - - - - - 5 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/StgToCmm/Closure.hs - compiler/GHC/StgToCmm/Prim.hs - docs/users_guide/exts/template_haskell.rst - libraries/ghc-prim/GHC/Tuple.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -1247,9 +1247,15 @@ primop NewSmallArrayOp "newSmallArray#" GenPrimOp out_of_line = True has_side_effects = True +primop ArrayOfOp "arrayOf#" GenPrimOp + o -> Array# b + {arrayOf# :: (# a, .., a #) -> Array# a} + with + has_side_effects = True + primop SmallArrayOfOp "smallArrayOf#" GenPrimOp o -> SmallArray# b - {smallArrayOf# :: (# a, .., a #) -> Array# a} + {smallArrayOf# :: (# a, .., a #) -> SmallArray# a} with has_side_effects = True ===================================== compiler/GHC/StgToCmm/Closure.hs ===================================== @@ -60,7 +60,6 @@ module GHC.StgToCmm.Closure ( cafBlackHoleInfoTable, indStaticInfoTable, staticClosureNeedsLink, - smallArrayStaticInfoTable, ) where #include "HsVersions.h" @@ -987,14 +986,6 @@ indStaticInfoTable , cit_srt = Nothing , cit_clo = Nothing } -smallArrayStaticInfoTable :: WordOff -> CmmInfoTable -smallArrayStaticInfoTable n - = CmmInfoTable { cit_lbl = mkSMAP_FROZEN_DIRTY_infoLabel - , cit_rep = smallArrPtrsRep (fromIntegral n) - , cit_prof = NoProfilingInfo - , cit_srt = Nothing - , cit_clo = Nothing } - staticClosureNeedsLink :: Bool -> CmmInfoTable -> Bool -- A static closure needs a link field to aid the GC when traversing -- the static closure graph. But it only needs such a field if either ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ScopedTypeVariables #-} #if __GLASGOW_HASKELL__ <= 808 -- GHC 8.10 deprecates this flag, but GHC 8.8 needs it @@ -58,7 +59,6 @@ import Data.Bits ((.&.), bit) import Control.Monad (liftM, when, unless) import GHC.Types.CostCentre (dontCareCCS) -import GHC.StgToCmm.Closure ------------------------------------------------------------------------ -- Primitive operations and foreign calls @@ -244,27 +244,9 @@ emitPrimOp dflags = \case (replicate (fromIntegral n) init) _ -> PrimopCmmEmit_External - op at SmallArrayOfOp -> \elems -> opAllDone $ \[res] -> do - let n = length elems - case allStatic elems of - Just known -> do - u <- newUnique - let lbl = mkUnliftedDataLabel u op - emitDataCon lbl (smallArrayStaticInfoTable n) dontCareCCS known - emit $ mkAssign (CmmLocal res) (CmmLit $ CmmLabel lbl) - Nothing -> doNewArrayOp - res - (smallArrPtrsRep (fromIntegral n)) - mkSMAP_FROZEN_DIRTY_infoLabel - [ ( mkIntExpr platform n - , fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags ) ] - elems - where - -- todo: comment - allStatic = foldr step (Just []) + op at ArrayOfOp -> doArrayOfOp dflags op - step (CmmLit l) (Just acc) = Just (l : acc) -- c.f. XXX getLit - step _ _ = Nothing + op at SmallArrayOfOp -> doArrayOfOp dflags op CopySmallArrayOp -> \case [src, src_off, dst, dst_off, (CmmLit (CmmInt n _))] -> @@ -2583,6 +2565,61 @@ doNewArrayOp res_r rep info payload inits = do emit $ mkAssign (CmmLocal res_r) (CmmReg arr) +doArrayOfOp :: DynFlags -> PrimOp -> [CmmExpr] -> PrimopCmmEmit +doArrayOfOp dflags op = \elems -> PrimopCmmEmit_IntoRegs $ \[res] -> do + let + n :: Int + n = length elems + + platform :: Platform + platform = targetPlatform dflags + + infoTbl :: CmmInfoTable + infoTbl = CmmInfoTable + { cit_lbl = lbl + , cit_rep = rep + , cit_prof = NoProfilingInfo + , cit_srt = Nothing + , cit_clo = Nothing } + + lbl :: CLabel + rep :: SMRep + hdr :: [(CmmExpr, ByteOff)] + (lbl, rep, hdr) = case op of + ArrayOfOp -> + ( mkMAP_FROZEN_DIRTY_infoLabel + , arrPtrsRep dflags (fromIntegral n) + , [ ( mkIntExpr platform n + , fixedHdrSize dflags + oFFSET_StgMutArrPtrs_ptrs dflags ) + , ( mkIntExpr platform (nonHdrSizeW (arrPtrsRep dflags n)) + , fixedHdrSize dflags + oFFSET_StgMutArrPtrs_size dflags ) + ] + ) + SmallArrayOfOp -> + ( mkSMAP_FROZEN_DIRTY_infoLabel + , smallArrPtrsRep (fromIntegral n) + , [ ( mkIntExpr platform n + , fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags + ) + ] + ) + _ -> error "Expected one of: ArrayOfOp, SmallArrayOfOp" + + if all isStatic elems + then do + u <- newUnique + let staticLbl = mkUnliftedDataLabel u op + emitDataCon staticLbl infoTbl dontCareCCS (map unsafeUnwrapLit elems) + emit $ mkAssign (CmmLocal res) (CmmLit $ CmmLabel staticLbl) + else doNewArrayOp res rep lbl hdr elems + +isStatic :: CmmExpr -> Bool +isStatic = \case CmmLit{} -> True; _ -> False + +unsafeUnwrapLit :: CmmExpr -> CmmLit +unsafeUnwrapLit (CmmLit i) = i +unsafeUnwrapLit _ = error "Expected CmmLit" + -- ---------------------------------------------------------------------------- -- Copying pointer arrays ===================================== docs/users_guide/exts/template_haskell.rst ===================================== @@ -115,7 +115,7 @@ The :extension:`TemplateHaskellQuotes` extension is considered safe under -- monad used to build the representation are propagated when using nested -- splices. f :: (Quote m, C m) => m Exp - f = [| 5 | ] + f = [| 5 |] -- f is used in a nested splice so the constraint on f, namely C, is propagated -- to a constraint on the whole representation. @@ -769,5 +769,3 @@ Run "main" and here is your output: $ ./main 3 1 - - ===================================== libraries/ghc-prim/GHC/Tuple.hs ===================================== @@ -5,7 +5,7 @@ -- Module : GHC.Tuple -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/ghc-prim/LICENSE) --- +-- -- Maintainer : libraries at haskell.org -- Stability : experimental -- Portability : non-portable (GHC extensions) @@ -167,6 +167,8 @@ data (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h = (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a1,b1,c1,d1,e1,f1,g1,h1,i1,j1,k1,l1,m1,n1,o1,p1,q1, r1,s1,t1,u1,v1,w1,x1,y1,z1,a2,b2,c2,d2,e2,f2,g2,h2,i2,j2) +-- [Why are GHC tuples limited to size 62?](https://stackoverflow.com/a/46416136) + {- Manuel says: Including one more declaration gives a segmentation fault. data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ @@ -238,7 +240,7 @@ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ -data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ +data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ data (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___ = (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) a b c d e f g h i j k l m n o p q r s t u v w x y z a_ b_ c_ d_ e_ f_ g_ h_ i_ j_ k_ l_ m_ n_ o_ p_ q_ r_ s_ t_ u_ v_ w_ x_ y_ z_ a__ b__ c__ d__ e__ f__ g__ h__ i__ j__ k__ l__ m__ n__ o__ p__ q__ r__ s__ t__ u__ v__ w__ x__ y__ z__ a___ b___ c___ d___ e___ f___ g___ h___ i___ j___ k___ l___ m___ n___ o___ p___ q___ r___ s___ t___ u___ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9995769c61751476e33a6f17ee307045cd9cb9bc...6c271b3240657f3d4c55e3a927fc7fd3bf342447 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9995769c61751476e33a6f17ee307045cd9cb9bc...6c271b3240657f3d4c55e3a927fc7fd3bf342447 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 13:34:17 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Sep 2020 09:34:17 -0400 Subject: [Git][ghc/ghc][wip/ftext-no-length] FastString: Remove cached length field Message-ID: <5f4e4dd9acecf_80beddf884101547ce@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/ftext-no-length at Glasgow Haskell Compiler / GHC Commits: 8493e16f by Sebastian Graf at 2020-09-01T15:33:31+02:00 FastString: Remove cached length field - - - - - 2 changed files: - compiler/GHC/Data/FastString.hs - compiler/GHC/Utils/Encoding.hs Changes: ===================================== compiler/GHC/Data/FastString.hs ===================================== @@ -184,7 +184,6 @@ of this string which is used by the compiler internally. -} data FastString = FastString { uniq :: {-# UNPACK #-} !Int, -- unique id - n_chars :: {-# UNPACK #-} !Int, -- number of chars fs_sbs :: {-# UNPACK #-} !ShortByteString, fs_zenc :: FastZString -- ^ Lazily computed z-encoding of this string. @@ -499,8 +498,7 @@ mkNewFastStringShortByteString :: ShortByteString -> Int -> IORef Int -> IO FastString mkNewFastStringShortByteString sbs uid n_zencs = do let zstr = mkZFastString n_zencs sbs - chars <- countUTF8Chars sbs - return (FastString uid chars sbs zstr) + return (FastString uid sbs zstr) hashStr :: ShortByteString -> Int -- produce a hash value between 0 & m (inclusive) @@ -525,7 +523,7 @@ hashStr sbs@(SBS.SBS ba#) = loop 0# 0# -- | Returns the length of the 'FastString' in characters lengthFS :: FastString -> Int -lengthFS fs = n_chars fs +lengthFS FastString{fs_sbs=sbs} = countUTF8Chars sbs -- | Returns @True@ if the 'FastString' is empty nullFS :: FastString -> Bool ===================================== compiler/GHC/Utils/Encoding.hs ===================================== @@ -170,13 +170,13 @@ utf8DecodeShortByteString (SBS ba#) let len# = sizeofByteArray# ba# in utf8DecodeLazy# (return ()) (utf8DecodeCharByteArray# ba#) len# -countUTF8Chars :: ShortByteString -> IO Int +countUTF8Chars :: ShortByteString -> Int countUTF8Chars (SBS ba) = go 0# 0# where len# = sizeofByteArray# ba go i# n# | isTrue# (i# >=# len#) = - return (I# n#) + (I# n#) | otherwise = do case utf8DecodeCharByteArray# ba i# of (# _, nBytes# #) -> go (i# +# nBytes#) (n# +# 1#) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8493e16ffce91bab1d7b7bb46583d30da6e10599 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8493e16ffce91bab1d7b7bb46583d30da6e10599 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 15:36:02 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Tue, 01 Sep 2020 11:36:02 -0400 Subject: [Git][ghc/ghc][wip/mono-local-binds] 360 commits: Improve handling of data type return kinds Message-ID: <5f4e6a62be7b9_80b10c95b34101687a6@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/mono-local-binds at Glasgow Haskell Compiler / GHC Commits: 4bf18646 by Simon Peyton Jones at 2020-07-03T08:37:42+01:00 Improve handling of data type return kinds Following a long conversation with Richard, this patch tidies up the handling of return kinds for data/newtype declarations (vanilla, family, and instance). I have substantially edited the Notes in TyCl, so they would bear careful reading. Fixes #18300, #18357 In GHC.Tc.Instance.Family.newFamInst we were checking some Lint-like properties with ASSSERT. Instead Richard and I have added a proper linter for axioms, and called it from lintGblEnv, which in turn is called in tcRnModuleTcRnM New tests (T18300, T18357) cause an ASSERT failure in HEAD. - - - - - 41d26492 by Sylvain Henry at 2020-07-03T17:33:59-04:00 DynFlags: avoid the use of sdocWithDynFlags in GHC.Core.Rules (#17957) - - - - - 7aa6ef11 by Hécate at 2020-07-03T17:34:36-04:00 Add the __GHC_FULL_VERSION__ CPP macro to expose the full GHC version - - - - - e61d5395 by Chaitanya Koparkar at 2020-07-07T13:55:59-04:00 ghc-prim: Turn some comments into haddocks [ci skip] - - - - - 37743f91 by John Ericson at 2020-07-07T13:56:00-04:00 Support `timesInt2#` in LLVM backend - - - - - 46397e53 by John Ericson at 2020-07-07T13:56:00-04:00 `genericIntMul2Op`: Call `genericWordMul2Op` directly This unblocks a refactor, and removes partiality. It might be a PowerPC regression but that should be fixable. - - - - - 8a1c0584 by John Ericson at 2020-07-07T13:56:00-04:00 Simplify `PrimopCmmEmit` Follow @simonpj's suggestion of pushing the "into regs" logic into `emitPrimOp`. With the previous commit getting rid of the recursion in `genericIntMul2Op`, this is now an easy refactor. - - - - - 6607f203 by John Ericson at 2020-07-07T13:56:00-04:00 `opAllDone` -> `opIntoRegs` The old name was and terrible and became worse after the previous commit's refactor moved non-trivial funcationlity into its body. - - - - - fdcc53ba by Sylvain Henry at 2020-07-07T13:56:00-04:00 Optimise genericIntMul2Op We shouldn't directly call 'genericWordMul2Op' in genericIntMul2Op because a target may provide a faster primop for 'WordMul2Op': we'd better use it! - - - - - 686e7225 by Moritz Angermann at 2020-07-07T13:56:01-04:00 [linker/rtsSymbols] More linker symbols Mostly symbols needed for aarch64/armv7l and in combination with musl, where we have to rely on loading *all* objects/archives - __stack_chk_* only when not DYNAMIC - - - - - 3f60b94d by Moritz Angermann at 2020-07-07T13:56:01-04:00 better if guards. - - - - - 7abffced by Moritz Angermann at 2020-07-07T13:56:01-04:00 Fix (1) - - - - - cdfeb3f2 by Moritz Angermann at 2020-07-07T13:56:01-04:00 AArch32 symbols only on aarch32. - - - - - f496c955 by Adam Sandberg Ericsson at 2020-07-07T13:56:02-04:00 add -flink-rts flag to link the rts when linking a shared or static library #18072 By default we don't link the RTS when linking shared libraries because in the most usual mode a shared library is an intermediary product, for example a Haskell library, that will be linked into some executable in the end. So we wish to defer the RTS flavour to link to the final link. However sometimes the final product is the shared library, for example when writing a plugin for some other system, so we do wish the shared library to link the RTS. For consistency we also make -staticlib honor this flag and its inversion. -staticlib currently implies -flink-shared. - - - - - c59faf67 by Stefan Schulze Frielinghaus at 2020-07-07T13:56:04-04:00 hadrian: link check-ppr against debugging RTS if ghcDebugged - - - - - 0effc57d by Adam Sandberg Ericsson at 2020-07-07T13:56:05-04:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 - - - - - 96153433 by Adam Sandberg Ericsson at 2020-07-07T13:56:06-04:00 hadrian: make hadrian/ghci use the bootstrap compiler from configure #18190 - - - - - 4d24f886 by Adam Sandberg Ericsson at 2020-07-07T13:56:07-04:00 hadrian: ignore cabal configure verbosity related flags #18131 - - - - - 7332bbff by Ben Gamari at 2020-07-07T13:56:08-04:00 testsuite: Widen T12234 acceptance window to 2% Previously it wasn't uncommon to see +/-1% fluctuations in compiler allocations on this test. - - - - - 180b6313 by Gabor Greif at 2020-07-07T13:56:08-04:00 When running libtool, report it as such - - - - - d3bd6897 by Sylvain Henry at 2020-07-07T13:56:11-04:00 BigNum: rename BigNat types Before this patch BigNat names were confusing because we had: * GHC.Num.BigNat.BigNat: unlifted type used everywhere else * GHC.Num.BigNat.BigNatW: lifted type only used to share static constants * GHC.Natural.BigNat: lifted type only used for backward compatibility After this patch we have: * GHC.Num.BigNat.BigNat#: unlifted type * GHC.Num.BigNat.BigNat: lifted type (reexported from GHC.Natural) Thanks to @RyanGlScott for spotting this. - - - - - 929d26db by Sylvain Henry at 2020-07-07T13:56:12-04:00 Bignum: don't build ghc-bignum with stage0 Noticed by @Ericson2314 - - - - - d25b6851 by Sylvain Henry at 2020-07-07T13:56:12-04:00 Hadrian: ghc-gmp.h shouldn't be a compiler dependency - - - - - 0ddae2ba by Sylvain Henry at 2020-07-07T13:56:14-04:00 DynFlags: factor out pprUnitId from "Outputable UnitId" instance - - - - - 204f3f5d by Krzysztof Gogolewski at 2020-07-07T13:56:18-04:00 Remove unused function pprHsForAllExtra (#18423) The function `pprHsForAllExtra` was called only on `Nothing` since 2015 (1e041b7382b6aa). - - - - - 3033e0e4 by Adam Sandberg Ericsson at 2020-07-08T20:36:49-04:00 hadrian: add flag to skip rebuilding dependency information #17636 - - - - - b7de4b96 by Stefan Schulze Frielinghaus at 2020-07-09T09:49:22-04:00 Fix GHCi :print on big-endian platforms On big-endian platforms executing import GHC.Exts data Foo = Foo Float# deriving Show foo = Foo 42.0# foo :print foo results in an arithmetic overflow exception which is caused by function index where moveBytes equals word_size - (r + item_size_b) * 8 Here we have a mixture of units. Both, word_size and item_size_b have unit bytes whereas r has unit bits. On 64-bit platforms moveBytes equals then 8 - (0 + 4) * 8 which results in a negative and therefore invalid second parameter for a shiftL operation. In order to make things more clear the expression (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes is equivalent to (word `shiftR` moveBytes) .&. mask On big-endian platforms the shift must be a left shift instead of a right shift. For symmetry reasons not a mask is used but two shifts in order to zero out bits. Thus the fixed version equals case endian of BigEndian -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits Fixes #16548 and #14455 - - - - - 3656dff8 by Sylvain Henry at 2020-07-09T09:50:01-04:00 LLVM: fix MO_S_Mul2 support (#18434) The value indicating if the carry is useful wasn't taken into account. - - - - - d9f09506 by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Define multiShotIO and use it in mkSplitUniqueSupply This patch is part of the ongoing eta-expansion saga; see #18238. It implements a neat trick (suggested by Sebastian Graf) that allows the programmer to disable the default one-shot behaviour of IO (the "state hack"). The trick is to use a new multiShotIO function; see Note [multiShotIO]. For now, multiShotIO is defined here in Unique.Supply; but it should ultimately be moved to the IO library. The change is necessary to get good code for GHC's unique supply; see Note [Optimising the unique supply]. However it makes no difference to GHC as-is. Rather, it makes a difference when a subsequent commit Improve eta-expansion using ArityType lands. - - - - - bce695cc by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Make arityType deal with join points As Note [Eta-expansion and join points] describes, this patch makes arityType deal correctly with join points. What was there before was not wrong, but yielded lower arities than it could. Fixes #18328 In base GHC this makes no difference to nofib. Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- n-body -0.1% -0.1% -1.2% -1.1% 0.0% -------------------------------------------------------------------------------- Min -0.1% -0.1% -55.0% -56.5% 0.0% Max -0.0% 0.0% +16.1% +13.4% 0.0% Geometric Mean -0.0% -0.0% -30.1% -31.0% -0.0% But it starts to make real difference when we land the change to the way mkDupableAlts handles StrictArg, in fixing #13253 and friends. I think this is because we then get more non-inlined join points. - - - - - 2b7c71cb by Simon Peyton Jones at 2020-07-11T12:17:02-04:00 Improve eta-expansion using ArityType As #18355 shows, we were failing to preserve one-shot info when eta-expanding. It's rather easy to fix, by using ArityType more, rather than just Arity. This patch is important to suport the one-shot monad trick; see #18202. But the extra tracking of one-shot-ness requires the patch Define multiShotIO and use it in mkSplitUniqueSupply If that patch is missing, ths patch makes things worse in GHC.Types.Uniq.Supply. With it, however, we see these improvements T3064 compiler bytes allocated -2.2% T3294 compiler bytes allocated -1.3% T12707 compiler bytes allocated -1.3% T13056 compiler bytes allocated -2.2% Metric Decrease: T3064 T3294 T12707 T13056 - - - - - de139cc4 by Artem Pelenitsyn at 2020-07-12T02:53:20-04:00 add reproducer for #15630 - - - - - c4de6a7a by Andreas Klebinger at 2020-07-12T02:53:55-04:00 Give Uniq[D]FM a phantom type for its key. This fixes #17667 and should help to avoid such issues going forward. The changes are mostly mechanical in nature. With two notable exceptions. * The register allocator. The register allocator references registers by distinct uniques. However they come from the types of VirtualReg, Reg or Unique in various places. As a result we sometimes cast the key type of the map and use functions which operate on the now typed map but take a raw Unique as actual key. The logic itself has not changed it just becomes obvious where we do so now. * <Type>Env Modules. As an example a ClassEnv is currently queried using the types `Class`, `Name`, and `TyCon`. This is safe since for a distinct class value all these expressions give the same unique. getUnique cls getUnique (classTyCon cls) getUnique (className cls) getUnique (tcName $ classTyCon cls) This is for the most part contained within the modules defining the interface. However it requires us to play dirty when we are given a `Name` to lookup in a `UniqFM Class a` map. But again the logic did not change and it's for the most part hidden behind the Env Module. Some of these cases could be avoided by refactoring but this is left for future work. We also bump the haddock submodule as it uses UniqFM. - - - - - c2cfdfde by Aaron Allen at 2020-07-13T09:00:33-04:00 Warn about empty Char enumerations (#18402) Currently the "Enumeration is empty" warning (-Wempty-enumerations) only fires for numeric literals. This patch adds support for `Char` literals so that enumerating an empty list of `Char`s will also trigger the warning. - - - - - c3ac87ec by Stefan Schulze Frielinghaus at 2020-07-13T09:01:10-04:00 hadrian: build check-ppr dynamic if GHC is build dynamic Fixes #18361 - - - - - 9ad072b4 by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Use dumpStyle when printing inlinings This just makes debug-printing consistent, and more informative. - - - - - e78c4efb by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Comments only - - - - - 7ccb760b by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Reduce result discount in conSize Ticket #18282 showed that the result discount given by conSize was massively too large. This patch reduces that discount to a constant 10, which just balances the cost of the constructor application itself. Note [Constructor size and result discount] elaborates, as does the ticket #18282. Reducing result discount reduces inlining, which affects perf. I found that I could increase the unfoldingUseThrehold from 80 to 90 in compensation; in combination with the result discount change I get these overall nofib numbers: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- boyer -0.2% +5.4% -3.2% -3.4% 0.0% cichelli -0.1% +5.9% -11.2% -11.7% 0.0% compress2 -0.2% +9.6% -6.0% -6.8% 0.0% cryptarithm2 -0.1% -3.9% -6.0% -5.7% 0.0% gamteb -0.2% +2.6% -13.8% -14.4% 0.0% genfft -0.1% -1.6% -29.5% -29.9% 0.0% gg -0.0% -2.2% -17.2% -17.8% -20.0% life -0.1% -2.2% -62.3% -63.4% 0.0% mate +0.0% +1.4% -5.1% -5.1% -14.3% parser -0.2% -2.1% +7.4% +6.7% 0.0% primetest -0.2% -12.8% -14.3% -14.2% 0.0% puzzle -0.2% +2.1% -10.0% -10.4% 0.0% rsa -0.2% -11.7% -3.7% -3.8% 0.0% simple -0.2% +2.8% -36.7% -38.3% -2.2% wheel-sieve2 -0.1% -19.2% -48.8% -49.2% -42.9% -------------------------------------------------------------------------------- Min -0.4% -19.2% -62.3% -63.4% -42.9% Max +0.3% +9.6% +7.4% +11.0% +16.7% Geometric Mean -0.1% -0.3% -17.6% -18.0% -0.7% I'm ok with these numbers, remembering that this change removes an *exponential* increase in code size in some in-the-wild cases. I investigated compress2. The difference is entirely caused by this function no longer inlining WriteRoutines.$woutputCodes = \ (w :: [CodeEvent]) -> let result_s1Sr = case WriteRoutines.outputCodes_$s$woutput w 0# 0# 8# 9# of (# ww1, ww2 #) -> (ww1, ww2) in (# case result_s1Sr of (x, _) -> map @Int @Char WriteRoutines.outputCodes1 x , case result_s1Sr of { (_, y) -> y } #) It was right on the cusp before, driven by the excessive result discount. Too bad! Happily, the compiler/perf tests show a number of improvements: T12227 compiler bytes-alloc -6.6% T12545 compiler bytes-alloc -4.7% T13056 compiler bytes-alloc -3.3% T15263 runtime bytes-alloc -13.1% T17499 runtime bytes-alloc -14.3% T3294 compiler bytes-alloc -1.1% T5030 compiler bytes-alloc -11.7% T9872a compiler bytes-alloc -2.0% T9872b compiler bytes-alloc -1.2% T9872c compiler bytes-alloc -1.5% Metric Decrease: T12227 T12545 T13056 T15263 T17499 T3294 T5030 T9872a T9872b T9872c - - - - - 7f0b671e by Ben Gamari at 2020-07-13T14:52:49-04:00 testsuite: Widen acceptance threshold on T5837 This test is positively tiny and consequently the bytes allocated measurement will be relatively noisy. Consequently I have seen this fail spuriously quite often. - - - - - 118e1c3d by Alp Mestanogullari at 2020-07-14T21:30:52-04:00 compiler: re-engineer the treatment of rebindable if Executing on the plan described in #17582, this patch changes the way if expressions are handled in the compiler in the presence of rebindable syntax. We get rid of the SyntaxExpr field of HsIf and instead, when rebindable syntax is on, we rewrite the HsIf node to the appropriate sequence of applications of the local `ifThenElse` function. In order to be able to report good error messages, with expressions as they were written by the user (and not as desugared by the renamer), we make use of TTG extensions to extend GhcRn expression ASTs with an `HsExpansion` construct, which keeps track of a source (GhcPs) expression and the desugared (GhcRn) expression that it gives rise to. This way, we can typecheck the latter while reporting the former in error messages. In order to discard the error context lines that arise from typechecking the desugared expressions (because they talk about expressions that the user has not written), we carefully give a special treatment to the nodes fabricated by this new renaming-time transformation when typechecking them. See Note [Rebindable syntax and HsExpansion] for more details. The note also includes a recipe to apply the same treatment to other rebindable constructs. Tests 'rebindable11' and 'rebindable12' have been added to make sure we report identical error messages as before this patch under various circumstances. We also now disable rebindable syntax when processing untyped TH quotes, as per the discussion in #18102 and document the interaction of rebindable syntax and Template Haskell, both in Note [Template Haskell quotes and Rebindable Syntax] and in the user guide, adding a test to make sure that we do not regress in that regard. - - - - - 64c774b0 by Andreas Klebinger at 2020-07-14T21:31:27-04:00 Explain why keeping DynFlags in AnalEnv saves allocation. - - - - - 254245d0 by Ben Gamari at 2020-07-14T21:32:03-04:00 docs/users-guide: Update default -funfolding-use-threshold value This was changed in 3d2991f8 but I neglected to update the documentation. Fixes #18419. - - - - - 4c259f86 by Andreas Klebinger at 2020-07-14T21:32:41-04:00 Escape backslashes in json profiling reports properly. I also took the liberty to do away the fixed buffer size for escaping. Using a fixed size here can only lead to issues down the line. Fixes #18438. - - - - - 23797224 by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 .gitlab: re-enable integer-simple substitute (BIGNUM_BACKEND) Recently build system migrated from INTEGER_LIBRARY to BIGNUM_BACKEND. But gitlab CI was never updated. Let's enable BIGNUM_BACKEND=native. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e0db878a by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 ghc-bignum: bring in sync .hs-boot files with module declarations Before this change `BIGNUM_BACKEND=native` build was failing as: ``` libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs:708:16: error: * Variable not in scope: naturalFromBigNat# :: WordArray# -> t * Perhaps you meant one of these: `naturalFromBigNat' (imported from GHC.Num.Natural), `naturalToBigNat' (imported from GHC.Num.Natural) | 708 | m' = naturalFromBigNat# m | ``` This happens because `.hs-boot` files are slightly out of date. This change brings in data and function types in sync. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - c9f65c36 by Stefan Schulze Frielinghaus at 2020-07-14T21:33:57-04:00 rts/Disassembler.c: Use FMT_HexWord for printing values in hex format - - - - - 58ae62eb by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 macOS: Load frameworks without stating them first. macOS Big Sur makes the following change to how frameworks are shipped with the OS: > New in macOS Big Sur 11 beta, the system ships with a built-in > dynamic linker cache of all system-provided libraries. As part of > this change, copies of dynamic libraries are no longer present on > the filesystem. Code that attempts to check for dynamic library > presence by looking for a file at a path or enumerating a directory > will fail. Instead, check for library presence by attempting to > dlopen() the path, which will correctly check for the library in the > cache. (62986286) https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/ Therefore, the previous method of checking whether a library exists before attempting to load it makes GHC.Runtime.Linker.loadFramework fail to find frameworks installed at /System/Library/Frameworks. GHC.Runtime.Linker.loadFramework now opportunistically loads the framework libraries without checking for their existence first, failing only if all attempts to load a given framework from any of the various possible locations fail. - - - - - cdc4a6b0 by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 loadFramework: Output the errors collected in all loading attempts. With the recent change away from first finding and then loading a framework, loadFramework had no way of communicating the real reason why loadDLL failed if it was any reason other than the framework missing from the file system. It now collects all loading attempt errors into a list and concatenates them into a string to return to the caller. - - - - - 51dbfa52 by Ben Gamari at 2020-07-15T04:05:34-04:00 StgToCmm: Use CmmRegOff smart constructor Previously we would generate expressions of the form `CmmRegOff BaseReg 0`. This should do no harm (and really should be handled by the NCG anyways) but it's better to just generate a plain `CmmReg`. - - - - - ae11bdfd by Ben Gamari at 2020-07-15T04:06:08-04:00 testsuite: Add regression test for #17744 Test due to @monoidal. - - - - - 0e3c277a by Ben Gamari at 2020-07-15T16:41:01-04:00 Bump Cabal submodule Updates a variety of tests as Cabal is now more strict about Cabal file form. - - - - - ceed994a by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Drop Windows Vista support, require Windows 7 - - - - - 00a23bfd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Update Windows FileSystem wrapper utilities. - - - - - 459e1c5f by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Use SlimReaderLocks and ConditonalVariables provided by the OS instead of emulated ones - - - - - 763088fc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Small linker comment and ifdef cleanups - - - - - 1a228ff9 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Flush event logs eagerly. - - - - - e9e04dda by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Refactor Buffer structures to be able to track async operations - - - - - 356dc3fe by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Implement new Console API - - - - - 90e69f77 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add IOPort synchronization primitive - - - - - 71245fcc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add new io-manager cmdline options - - - - - d548a3b3 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Init Windows console Codepage to UTF-8. - - - - - 58ef6366 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add unsafeSplat to GHC.Event.Array - - - - - d660725e by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add size and iterate to GHC.Event.IntTable. - - - - - 050da6dd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Switch Testsuite to test winio by default - - - - - 4bf542bf by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Multiple refactorings and support changes. - - - - - 4489af6b by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core threaded I/O manager - - - - - 64d8f2fe by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core non-threaded I/O manager - - - - - 8da15a09 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix a scheduler bug with the threaded-runtime. - - - - - 84ea3d14 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Relaxing some constraints in io-manager. - - - - - ccf0d107 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix issues with non-threaded I/O manager after split. - - - - - b492fe6e by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Remove some barf statements that are a bit strict. - - - - - 01423fd2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Expand comments describing non-threaded loop - - - - - 4b69004f by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: fix FileSize unstat-able handles - - - - - 9b384270 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Implement new tempfile routines for winio - - - - - f1e0be82 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix input truncation when reading from handle. This was caused by not upholding the read buffer invariant that bufR == bufL == 0 for empty read buffers. - - - - - e176b625 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix output truncation for writes larger than buffer size - - - - - a831ce0e by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Rewrite bufWrite. I think it's far easier to follow the code now. It's also correct now as I had still missed a spot where we didn't update the offset. - - - - - 6aefdf62 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix offset set by bufReadEmpty. bufReadEmpty returns the bytes read *including* content that was already buffered, But for calculating the offset we only care about the number of bytes read into the new buffer. - - - - - 750ebaee by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Clean up code surrounding IOPort primitives. According to phyx these should only be read and written once per object. Not neccesarily in that order. To strengthen that guarantee the primitives will now throw an exception if we violate this invariant. As a consequence we can eliminate some code from their primops. In particular code dealing with multiple queued readers/writers now simply checks the invariant and throws an exception if it was violated. That is in contrast to mvars which will do things like wake up all readers, queue multi writers etc. - - - - - ffd31db9 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix multi threaded threadDelay and a few other small changes. Multithreaded threadDelay suffered from a race condition based on the ioManagerStatus. Since the status isn't needed for WIO I removed it completely. This resulted in a light refactoring, as consequence we will always wake up the IO manager using interruptSystemManager, which uses `postQueuedCompletionStatus` internally. I also added a few comments which hopefully makes the code easier to dive into for the next person diving in. - - - - - 6ec26df2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 wionio: Make IO subsystem check a no-op on non-windows platforms. - - - - - 29bcd936 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Set handle offset when opening files in Append mode. Otherwise we would truncate the file. - - - - - 55c29700 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Remove debug event log trace - - - - - 9acb9f40 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix sqrt and openFile009 test cases - - - - - 57017cb7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Allow hp2ps to build with -DDEBUG - - - - - b8cd9995 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update output of T9681 since we now actually run it. - - - - - 10af5b14 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: A few more improvements to the IOPort primitives. - - - - - 39afc4a7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix expected tempfiles output. Tempfiles now works properly on windows, as such we can delete the win32 specific output. - - - - - 99db46e0 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Assign thread labels to IOManager threads. - - - - - be6af732 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Properly check for the tso of an incall to be zero. - - - - - e2c6dac7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark FD instances as unsupported under WINIO. - - - - - fd02ceed by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix threadDelay maxBound invocations. Instead of letting the ns timer overflow now clamp it at (maxBound :: Word64) ns. That still gives a few hundred years. - - - - - bc79f9f1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comments/cleanup an import in base - - - - - 1d197f4b by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark outstanding_service_requests volatile. As far as I know C(99) gives no guarantees for code like bool condition; ... while(condition) sleep(); that condition will be updated if it's changed by another thread. So we are explicit here and mark it as volatile, this will force a reload from memory on each iteration. - - - - - dc438186 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Make last_event a local variable - - - - - 2fc957c5 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comment about thread safety of processCompletion. - - - - - 4c026b6c by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: nonthreaded: Create io processing threads in main thread. We now set a flag in the IO thread. The scheduler when looking for work will check the flag and create/queue threads accordingly. We used to create these in the IO thread. This improved performance but caused frequent segfaults. Thread creation/allocation is only safe to do if nothing currently accesses the storeagemanager. However without locks in the non-threaded runtime this can't be guaranteed. This shouldn't change performance all too much. In the past we had: * IO: Create/Queue thread. * Scheduler: Runs a few times. Eventually picks up IO processing thread. Now it's: * IO: Set flag to queue thread. * Scheduler: Pick up flag, if set create/queue thread. Eventually picks up IO processing thread. - - - - - f47c7208 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add an exported isHeapAlloced function to the RTS - - - - - cc5d7bb1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Queue IO processing threads at the front of the queue. This will unblock the IO thread sooner hopefully leading to higher throughput in some situations. - - - - - e7630115 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: ThreadDelay001: Use higher resolution timer. - - - - - 451b5f96 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update T9681 output, disable T4808 on windows. T4808 tests functionality of the FD interface which won't be supported under WINIO. T9681 just has it's expected output tweaked. - - - - - dd06f930 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Wake io manager once per registerTimeout. Which is implicitly done in editTimeouts, so need to wake it up twice. - - - - - e87d0bf9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update placeholder comment with actual function name. - - - - - fc9025db by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Always lock win32 event queue - - - - - c24c9a1f by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Display thread labels when tracing scheduler events. - - - - - 06542b03 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Refactor non-threaded runner thread and scheduler interface. Only use a single communication point (registerAlertableWait) to inform the C side aobut both timeouts to use as well as outstanding requests. Also queue a haskell processing thread after each return from alertable waits. This way there is no risk of us missing a timer event. - - - - - 256299b1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove outstanding_requests from runner. We used a variable to keep track of situations where we got entries from the IO port, but all of them had already been canceled. While we can avoid some work that way this case seems quite rare. So we give up on tracking this and instead always assume at least one of the returned entries is valid. If that's not the case no harm is done, we just perform some additional work. But it makes the runner easier to reason about. In particular we don't need to care if another thread modifies oustanding_requests after we return from waiting on the IO Port. - - - - - 3ebd8ad9 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Various fixes related to rebase and testdriver - - - - - 6be6bcba by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Fix rebase artifacts - - - - - 2c649dc3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename unsafeSplat to unsafeCopyFromBuffer - - - - - a18b73f3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove unused size/iterate operations from IntTable - - - - - 16bab48e by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Detect running IO Backend via peeking at RtsConfig - - - - - 8b8405a0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update temp path so GCC etc can handle it. Also fix PIPE support, clean up error casting, fix memory leaks - - - - - 2092bc54 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Minor comments/renamings - - - - - a5b5b6c0 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Checking if an error code indicates completion is now a function. - - - - - 362176fd by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Small refactor in withOverlappedEx - - - - - 32e20597 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: A few comments and commented out dbxIO - - - - - a4bfc1d9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't drop buffer offset in byteView/cwcharView - - - - - b3ad2a54 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: revert BHandle changes. - - - - - 3dcd87e2 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Fix imports - - - - - 5a371890 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update ghc-cabal to handle new Cabal submodule bump - - - - - d07ebe0d by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Only compile sources on Windows - - - - - dcb42393 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Actually return Nothing on EOF for non-blocking read - - - - - 895a3beb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate logic in encodeMultiByte[Raw]IO. - - - - - e06e6734 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate openFile logic - - - - - b59430c0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: fix -werror issue in encoding file - - - - - f8d39a51 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't mention windows specific functions when building on Linux. - - - - - 6a533d2a by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add a note about file locking in the RTS. - - - - - cf37ce34 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Add version to @since annotation - - - - - 0fafa2eb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename GHC.Conc.IOCP -> GHC.Conc.WinIO - - - - - 1854fc23 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Expand GHC.Conc.POSIX description It now explains users may not use these functions when using the old IO manager. - - - - - fcc7ba41 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Fix potential spaceleak in __createUUIDTempFileErrNo - - - - - 6b3fd9fa by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant -Wno-missing-signatures pragmas - - - - - 916fc861 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Make it explicit that we only create one IO manager - - - - - f260a721 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Note why we don't use blocking waits. - - - - - aa0a4bbf by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove commented out pragma - - - - - d679b544 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant buffer write in Handle/Text.hs:bufReadEmpty - - - - - d3f94368 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename SmartHandles to StdHandles - - - - - bd6b8ec1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add comment stating failure behaviour for getUniqueFileInfo. - - - - - 12846b85 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update IOPort haddocks. - - - - - 9f39fb14 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Add a note cross reference - - - - - 62dd5a73 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Name Haskell/OS I/O Manager explicitly in Note - - - - - fa807828 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Expand BlockedOnIOCompletion description. - - - - - f0880a1d by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove historical todos - - - - - 8e58e714 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Update note, remove debugging pragma. - - - - - aa4d84d5 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: flushCharReadBuffer shouldn't need to adjust offsets. - - - - - e580893a by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove obsolete comment about cond. variables - - - - - d54e9d79 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix initial linux validate build - - - - - 3cd4de46 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix ThreadDelay001 CPP - - - - - c88b1b9f by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix openFile009 merge conflict leftover - - - - - 849e8889 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept T9681 output. GHC now reports String instead of [Char]. - - - - - e7701818 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix cabal006 after upgrading cabal submodule Demand cabal 2.0 syntax instead of >= 1.20 as required by newer cabal versions. - - - - - a44f0373 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix stderr output for ghci/linking/dyn tests. We used to filter rtsopts, i opted to instead just accept the warning of it having no effect. This works both for -rtsopts, as well as -with-rtsopts which winio adds. - - - - - 515d9896 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T15261b stdout for --io-manager flag. - - - - - 949aaacc by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T5435_dyn_asm stderr The warning about rtsopts having no consequences is expected. So accept new stderr. - - - - - 7d424e1e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Also accept T7037 stderr - - - - - 1f009768 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal04 by filtering rts args - - - - - 981a9f2e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal01 by accepting expected stderr - - - - - b7b0464e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix safePkg01 by accepting expected stderr - - - - - 32734b29 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix T5435_dyn_gcc by accepting expected stderr - - - - - acc5cebf by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix tempfiles test on linux - - - - - c577b789 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for T3807 - - - - - c108c527 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload - - - - - 2b0b9a08 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload_multiple_objs - - - - - 67afb03c by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify wording on conditional variables. - - - - - 3bd41572 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify comment on cooked mode. - - - - - ded58a03 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: update lockfile signature and remove mistaken symbol in rts. - - - - - 2143c492 by Ben Gamari at 2020-07-15T16:41:04-04:00 testsuite: Add winio and winio_threaded ways Reverts many of the testsuite changes - - - - - c0979cc5 by Ben Gamari at 2020-07-16T10:56:54-04:00 Merge remote-tracking branch 'origin/wip/winio' - - - - - 750a1595 by Ben Gamari at 2020-07-18T07:26:41-04:00 rts: Add --copying-gc flag to reverse effect of --nonmoving-gc Fixes #18281. - - - - - 6ba6a881 by Hécate at 2020-07-18T07:26:42-04:00 Implement `fullCompilerVersion` Follow-up of https://gitlab.haskell.org/ghc/ghc/-/issues/18403 This MR adds `fullCompilerVersion`, a function that shares the same backend as the `--numeric-version` GHC flag, exposing a full, three-digit version datatype. - - - - - e6cf27df by Hécate at 2020-07-18T07:26:43-04:00 Add a Lint hadrian rule and an .hlint.yaml file in base/ - - - - - bcb177dd by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Allow multiple case branches to have a higher rank type As #18412 points out, it should be OK for multiple case alternatives to have a higher rank type, provided they are all the same. This patch implements that change. It sweeps away GHC.Tc.Gen.Match.tauifyMultipleBranches, and friends, replacing it with an enhanced version of fillInferResult. The basic change to fillInferResult is to permit the case in which another case alternative has already filled in the result; and in that case simply unify. It's very simple actually. See the new Note [fillInferResult] in TcMType Other refactoring: - Move all the InferResult code to one place, in GHC.Tc.Utils.TcMType (previously some of it was in Unify) - Move tcInstType and friends from TcMType to Instantiate, where it more properly belongs. (TCMType was getting very long.) - - - - - e5525a51 by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Improve typechecking of NPlusK patterns This patch (due to Richard Eisenberg) improves documentation of the wrapper returned by tcSubMult (see Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify). And, more substantially, it cleans up the multiplicity handling in the typechecking of NPlusKPat - - - - - 12f90352 by Krzysztof Gogolewski at 2020-07-18T07:26:45-04:00 Remove {-# CORE #-} pragma (part of #18048) This pragma has no effect since 2011. It was introduced for External Core, which no longer exists. Updates haddock submodule. - - - - - e504c913 by Simon Peyton Jones at 2020-07-18T07:26:45-04:00 Refactor the simplification of join binders This MR (for #18449) refactors the Simplifier's treatment of join-point binders. Specifically, it puts together, into GHC.Core.Opt.Simplify.Env.adjustJoinPointType two currently-separate ways in which we adjust the type of a join point. As the comment says: -- (adjustJoinPointType mult new_res_ty join_id) does two things: -- -- 1. Set the return type of the join_id to new_res_ty -- See Note [Return type for join points] -- -- 2. Adjust the multiplicity of arrows in join_id's type, as -- directed by 'mult'. See Note [Scaling join point arguments] I think this actually fixes a latent bug, by ensuring that the seIdSubst and seInScope have the right multiplicity on the type of join points. I did some tidying up while I was at it. No more setJoinResTy, or modifyJoinResTy: instead it's done locally in Simplify.Env.adjustJoinPointType - - - - - 49b265f0 by Chaitanya Koparkar at 2020-07-18T07:26:46-04:00 Fix minor typos in a Core.hs note - - - - - 8d59aed6 by Stefan Schulze Frielinghaus at 2020-07-18T07:26:47-04:00 GHCi: Fix isLittleEndian - - - - - c26e81d1 by Ben Gamari at 2020-07-18T07:26:47-04:00 testsuite: Mark ghci tests as fragile under unreg compiler In particular I have seen T16012 fail repeatedly under the unregisterised compiler. - - - - - 868e4523 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "AArch32 symbols only on aarch32." This reverts commit cdfeb3f24f76e8fd30452016676e56fbc827789a. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - c915ba84 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "Fix (1)" This reverts commit 7abffced01f5680efafe44f6be2733eab321b039. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 777c452a by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "better if guards." This reverts commit 3f60b94de1f460ca3f689152860b108a19ce193e. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 0dd40552 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "[linker/rtsSymbols] More linker symbols" This reverts commit 686e72253aed3880268dd6858eadd8c320f09e97. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 30caeee7 by Sylvain Henry at 2020-07-21T06:39:33-04:00 DynFlags: remove use of sdocWithDynFlags from GHC.Stg.* (#17957) * add StgPprOpts datatype * remove Outputable instances for types that need `StgPprOpts` to be pretty-printed and explicitly call type specific ppr functions * add default `panicStgPprOpts` for panic messages (when it's not convenient to thread StgPprOpts or DynFlags down to the ppr function call) - - - - - 863c544c by Mark at 2020-07-21T06:39:34-04:00 Fix a typo in existential_quantification.rst - - - - - 05910be1 by Krzysztof Gogolewski at 2020-07-21T14:47:07-04:00 Add release notes entry for #17816 [skip ci] - - - - - a6257192 by Matthew Pickering at 2020-07-21T14:47:19-04:00 Use a newtype `Code` for the return type of typed quotations (Proposal #195) There are three problems with the current API: 1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition of two type constructors. Doing so in your program involves making your own newtype and doing a lot of wrapping/unwrapping. For example, if I want to create a language which I can either run immediately or generate code from I could write the following with the new API. :: class Lang r where _int :: Int -> r Int _if :: r Bool -> r a -> r a -> r a instance Lang Identity where _int = Identity _if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f) instance Quote m => Lang (Code m) where _int = liftTyped _if cb ct cf = [|| if $$cb then $$ct else $$cf ||] 2. When doing code generation it is common to want to store code fragments in a map. When doing typed code generation, these code fragments contain a type index so it is desirable to store them in one of the parameterised map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from ``parameterized-utils``. :: compiler :: Env -> AST a -> Code Q a data AST a where ... data Ident a = ... type Env = MapF Ident (Code Q) newtype Code m a = Code (m (TExp a)) In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``. Using one of these map types currently requires creating your own newtype and constantly wrapping every quotation and unwrapping it when using a splice. Achievable, but it creates even more syntactic noise than normal metaprogramming. 3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is easier. This is a weak reason but one everyone can surely agree with. Updates text submodule. - - - - - 58235d46 by Ben Gamari at 2020-07-21T14:47:28-04:00 users-guide: Fix :rts-flag:`--copying-gc` documentation It was missing a newline. - - - - - 19e80b9a by Vladislav Zavialov at 2020-07-21T14:50:01-04:00 Accumulate Haddock comments in P (#17544, #17561, #8944) Haddock comments are, first and foremost, comments. It's very annoying to incorporate them into the grammar. We can take advantage of an important property: adding a Haddock comment does not change the parse tree in any way other than wrapping some nodes in HsDocTy and the like (and if it does, that's a bug). This patch implements the following: * Accumulate Haddock comments with their locations in the P monad. This is handled in the lexer. * After parsing, do a pass over the AST to associate Haddock comments with AST nodes using location info. * Report the leftover comments to the user as a warning (-Winvalid-haddock). - - - - - 4c719460 by David Binder at 2020-07-22T20:17:35-04:00 Fix dead link to haskell prime discussion - - - - - f2f817e4 by BinderDavid at 2020-07-22T20:17:35-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 0bf8980e by Daniel Gröber at 2020-07-22T20:18:11-04:00 Remove length field from FastString - - - - - 1010c33b by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 8336ba78 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - 7484a9a4 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 5536ed28 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 5b8902e3 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - 5976a161 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 9ddf1614 by Daniel Gröber at 2020-07-22T20:18:11-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - e9491668 by Ben Gamari at 2020-07-22T20:18:46-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 9f3ff8fd by Andreas Klebinger at 2020-07-22T20:19:22-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - 0f17b930 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - bab4ec8f by Sylvain Henry at 2020-07-22T20:19:59-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - 8ea33edb by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused sGhcWithNativeCodeGen - - - - - e079bb72 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - 735f9d6b by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - f7cc4313 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace HscTarget with Backend They both have the same role and Backend name is more explicit. Metric Decrease: T3064 Update Haddock submodule - - - - - 15ce1804 by Andreas Klebinger at 2020-07-22T20:20:34-04:00 Deprecate -fdmd-tx-dict-sel. It's behaviour is now unconditionally enabled as it's slightly beneficial. There are almost no benchmarks which benefit from disabling it, so it's not worth the keep this configurable. This fixes #18429. - - - - - ff1b7710 by Sylvain Henry at 2020-07-22T20:21:11-04:00 Add test for #18064 It has been fixed by 0effc57d48ace6b719a9f4cbeac67c95ad55010b - - - - - cfa89149 by Krzysztof Gogolewski at 2020-07-22T20:21:48-04:00 Define type Void# = (# #) (#18441) There's one backwards compatibility issue: GHC.Prim no longer exports Void#, we now manually re-export it from GHC.Exts. - - - - - 02f40b0d by Sebastian Graf at 2020-07-22T20:22:23-04:00 Add regression test for #18478 !3392 backported !2993 to GHC 8.10.2 which most probably is responsible for fixing #18478, which triggered a pattern match checker performance regression in GHC 8.10.1 as first observed in #17977. - - - - - 7f44df1e by Sylvain Henry at 2020-07-22T20:23:00-04:00 Minor refactoring of Unit display * for consistency, try to always use UnitPprInfo to display units to users * remove some uses of `unitPackageIdString` as it doesn't show the component name and it uses String - - - - - dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - cdd0ff16 by Tamar Christina at 2020-07-24T18:12:23-04:00 winio: restore console cp on exit - - - - - c1f4f81d by Tamar Christina at 2020-07-24T18:13:00-04:00 winio: change memory allocation strategy and fix double free errors. - - - - - ba205046 by Simon Peyton Jones at 2020-07-24T18:13:35-04:00 Care with occCheckExpand in kind of occurrences Issue #18451 showed that we could get an infinite type, through over-use of occCheckExpand in the kind of an /occurrence/ of a type variable. See Note [Occurrence checking: look inside kinds] in GHC.Core.Type This patch fixes the problem by making occCheckExpand less eager to expand synonyms in kinds. It also improves pretty printing of kinds, by *not* suppressing the kind on a tyvar-binder like (a :: Const Type b) where type Const p q = p. Even though the kind of 'a' is Type, we don't want to suppress the kind ascription. Example: the error message for polykinds/T18451{a,b}. See GHC.Core.TyCo.Ppr Note [Suppressing * kinds]. - - - - - 02133353 by Zubin Duggal at 2020-07-25T00:44:30-04:00 Simplify XRec definition Change `Located X` usage to `XRec pass X` This increases the scope of the LPat experiment to almost all of GHC. Introduce UnXRec and MapXRec classes Fixes #17587 and #18408 Updates haddock submodule Co-authored-by: Philipp Krüger <philipp.krueger1 at gmail.com> - - - - - e443846b by Sylvain Henry at 2020-07-25T00:45:07-04:00 DynFlags: store printer in TraceBinIfaceReading We don't need to pass the whole DynFlags, just pass the logging function, if any. - - - - - 15b2b44f by Sylvain Henry at 2020-07-25T00:45:08-04:00 Rename GHC.Driver.Ways into GHC.Platform.Ways - - - - - 342a01af by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add GHC.Platform.Profile - - - - - 6333d739 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Put PlatformConstants into Platform - - - - - 9dfeca6c by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove platform constant wrappers Platform constant wrappers took a DynFlags parameter, hence implicitly used the target platform constants. We removed them to allow support for several platforms at once (#14335) and to avoid having to pass the full DynFlags to every function (#17957). Metric Decrease: T4801 - - - - - 73145d57 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove dead code in utils/derivConstants - - - - - 7721b923 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Move GHC.Platform into the compiler Previously it was in ghc-boot so that ghc-pkg could use it. However it wasn't necessary because ghc-pkg only uses a subset of it: reading target arch and OS from the settings file. This is now done via GHC.Platform.ArchOS (was called PlatformMini before). - - - - - 459afeb5 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Fix build systems - - - - - 9e2930c3 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Bump CountParserDeps - - - - - 6e2db34b by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add accessors to ArchOS - - - - - fc0f6fbc by Stefan Schulze Frielinghaus at 2020-07-25T00:45:45-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 - - - - - a7c4439a by Matthias Andreas Benkard at 2020-07-26T13:23:24-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. - - - - - da7269a4 by Ben Gamari at 2020-07-26T13:23:59-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. - - - - - f153a1d0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Update win32 output for parseTree - - - - - e91672f0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. - - - - - 9cbfe086 by Ben Gamari at 2020-07-26T13:23:59-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. - - - - - 8236925f by Tamar Christina at 2020-07-26T13:24:35-04:00 winio: remove dead argument to stg_newIOPortzh - - - - - ce0a1d67 by Tamar Christina at 2020-07-26T13:25:11-04:00 winio: fix detection of tty terminals - - - - - 52685cf7 by Tamar Christina at 2020-07-26T13:25:48-04:00 winio: update codeowners - - - - - aee45d9e by Vladislav Zavialov at 2020-07-27T07:06:56-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. - - - - - 667ab69e by leiftw at 2020-07-27T07:07:32-04:00 fix typo referring to non-existent `-ohidir` flag, should be `-hidir` I think - - - - - 6ff89c17 by Vladislav Zavialov at 2020-07-27T07:08:07-04:00 Refactor the parser a little * Create a dedicated production for type operators * Create a dedicated type for the UNPACK pragma * Remove an outdated part of Note [Parsing data constructors is hard] - - - - - aa054d32 by Ben Gamari at 2020-07-27T20:09:07-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. - - - - - 6da73bbf by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Add minimal test for #12492 - - - - - 47680cb7 by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Use allocate, not ALLOC_PRIM_P for unpackClosure# ALLOC_PRIM_P fails for large closures, by directly using allocate we can handle closures which are larger than the block size. Fixes #12492 - - - - - 3d345c96 by Simon Peyton Jones at 2020-07-27T20:10:19-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 - - - - - 57aca6bb by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. - - - - - 0a815cea by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. - - - - - 0bd60059 by Simon Peyton Jones at 2020-07-28T02:01:49-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 - - - - - 6ee07b49 by Sylvain Henry at 2020-07-28T02:02:27-04:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - f305bbfd by Peter Trommler at 2020-07-28T02:03:02-04:00 config: Fix Haskell platform constructor w/ params Fixes #18505 - - - - - 318bb17c by Oleg Grenrus at 2020-07-28T20:54:13-04:00 Fix typo in haddock Spotted by `vilpan` on `#haskell` - - - - - 39c89862 by Sergei Trofimovich at 2020-07-28T20:54:50-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b9a880fc by Felix Wiemuth at 2020-07-29T15:06:35-04:00 Fix typo - - - - - c59064b0 by Brandon Chinn at 2020-07-29T15:07:11-04:00 Add regression test for #16341 - - - - - a61411ca by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass dit_rep_tc_args to dsm_stock_gen_fn - - - - - a26498da by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass tc_args to gen_fn - - - - - 44b11bad by Brandon Chinn at 2020-07-29T15:07:11-04:00 Filter out unreachable constructors when deriving stock instances (#16431) - - - - - bbc51916 by Simon Peyton Jones at 2020-07-29T15:07:47-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 - - - - - e3db4b4c by Peter Trommler at 2020-07-29T15:08:22-04:00 configure: Fix build system on ARM - - - - - 96c31ea1 by Sylvain Henry at 2020-07-29T15:09:02-04:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - e1dc3d7b by Krzysztof Gogolewski at 2020-07-29T15:09:39-04:00 Fix validation errors (#18510) Test T2632 is a stage1 test that failed because of the Q => Quote change. The remaining tests did not use quotation and failed when the path contained a space. - - - - - 6c68a842 by John Ericson at 2020-07-30T07:11:02-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. - - - - - 502de556 by cgibbard at 2020-07-30T07:11:02-04:00 Add haddock comment for unfilteredEdges and move the note about drop_hs_boot_nodes into it. - - - - - 01c948eb by Ryan Scott at 2020-07-30T07:11:37-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. - - - - - d47324ce by Ryan Scott at 2020-07-30T07:12:16-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. - - - - - ebe2cf45 by Simon Peyton Jones at 2020-07-30T07:12:52-04:00 Remove an incorrect WARN in extendLocalRdrEnv I noticed this warning going off, and discovered that it's really fine. This small patch removes the warning, and docments what is going on. - - - - - 9f71f697 by Simon Peyton Jones at 2020-07-30T07:13:27-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d - - - - - 7c274cd5 by Sylvain Henry at 2020-07-30T22:54:48-04:00 Fix minimal imports dump for boot files (fix #18497) - - - - - 175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00 DynFlags: don't use sdocWithDynFlags in datacon ppr We don't need to use `sdocWithDynFlags` to know whether we should display linear types for datacon types, we already have `sdocLinearTypes` field in `SDocContext`. Moreover we want to remove `sdocWithDynFlags` (#10143, #17957)). - - - - - 380638a3 by Sylvain Henry at 2020-07-30T22:56:03-04:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - 56a7c193 by Sylvain Henry at 2020-07-31T19:32:09+02:00 Refactor CLabel pretty-printing Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove (#10143, #17957). It uses it to query the backend and the platform. This patch exposes Clabel ppr functions specialised for each backend so that backend code can directly use them. - - - - - 3b15dc3c by Sylvain Henry at 2020-07-31T19:32:09+02:00 DynFlags: don't use sdocWithDynFlags in GHC.CmmToAsm.Dwarf.Types - - - - - e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00 Test case for #17652 The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec - - - - - 22641742 by Ryan Scott at 2020-08-02T16:44:11-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. - - - - - f2d1accf by Leon Schoorl at 2020-08-02T16:44:47-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 - - - - - 947206f4 by Niklas Hambüchen at 2020-08-03T07:52:33+02:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. - - - - - ef2ae81a by Alex Biehl at 2020-08-03T07:52:33+02:00 Hardcode RTS includes to cope with unregistered builds - - - - - d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 5e12cd17 by Krzysztof Gogolewski at 2020-08-05T04:00:04-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. - - - - - 2bff2f87 by Ben Gamari at 2020-08-05T04:00:39-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. - - - - - 53ce0db5 by Ben Gamari at 2020-08-05T04:00:39-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. - - - - - eb7013c3 by Hécate at 2020-08-05T04:01:15-04:00 Remove all the unnecessary LANGUAGE pragmas - - - - - fbcb886d by Ryan Scott at 2020-08-05T04:01:51-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. - - - - - 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 2c906b38 by Sebastian Graf at 2020-09-01T17:33:36+02:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - 29 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - .gitlab/test-metrics.sh - CODEOWNERS - Makefile - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - + compiler/GHC/Builtin/RebindableNames.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d216a2c818235cfa1cbd0756b146223e08430d59...2c906b385b4c6453c72260c87aaa48cb11c40098 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d216a2c818235cfa1cbd0756b146223e08430d59...2c906b385b4c6453c72260c87aaa48cb11c40098 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 15:37:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Sep 2020 11:37:01 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 2 commits: Fix documentation and fix "check" bignum backend (#18604) Message-ID: <5f4e6a9d8d7c_80b3f849245677010170644@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: a3e90763 by Sylvain Henry at 2020-09-01T10:22:24+02:00 Fix documentation and fix "check" bignum backend (#18604) (cherry-picked from 0a3723876c6c79a0a407d50f4baa2818a13f232e) - - - - - d5c3a027 by Sylvain Henry at 2020-09-01T10:22:46+02:00 Bignum: add BigNat compat functions (#18613) (cherry-picked from a8a2568b7b64e5b9fca5b12df7da759de4db39ae) - - - - - 6 changed files: - libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs - libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs - libraries/ghc-bignum/src/GHC/Num/WordArray.hs - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs Changes: ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/Check.hs ===================================== @@ -129,8 +129,8 @@ mwaCompareOpBool mwa f g s = 0# -> case unexpectedValue of !_ -> (# s, ra #) -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives - _ -> case (ra ==# 1#) of -- don't compare MWAs if overflow signaled! - 1# -> (# s, ra #) + _ -> case ra of -- don't compare MWAs if underflow signaled! + 0# -> (# s, ra #) -- underflow _ -> case mwaTrimZeroes# mwa s of { s -> case mwaTrimZeroes# mwb s of { s -> case mwaCompare mwa mwb s of ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/FFI.hs ===================================== @@ -113,7 +113,7 @@ foreign import ccall unsafe ghc_bignat_mul_word -- The potential 0 most-significant Words will be removed by the caller if it is -- not already done by the backend. -- --- Return True to indicate overflow. +-- Return False# to indicate underflow. bignat_sub :: MutableWordArray# RealWorld -> WordArray# @@ -136,7 +136,7 @@ foreign import ccall unsafe ghc_bignat_sub -- The potential 0 most-significant Words will be removed by the caller if it is -- not already done by the backend. -- --- Return True to indicate overflow. +-- Return False# to indicate underflow. bignat_sub_word :: MutableWordArray# RealWorld -> WordArray# ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/GMP.hs ===================================== @@ -92,8 +92,8 @@ bignat_sub {-# INLINE bignat_sub #-} bignat_sub mwa wa wb s = case ioWord# (c_mpn_sub mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of - (# s', 1## #) -> (# s', 0# #) -- overflow - (# s', _ #) -> (# s', 1# #) -- no overflow + (# s', 1## #) -> (# s', 0# #) -- underflow + (# s', _ #) -> (# s', 1# #) -- no underflow bignat_sub_word :: MutableWordArray# RealWorld @@ -104,8 +104,8 @@ bignat_sub_word {-# INLINE bignat_sub_word #-} bignat_sub_word mwa wa b s = case ioWord# (c_mpn_sub_1 mwa wa (wordArraySize# wa) b) s of - (# s', 1## #) -> (# s', 0# #) -- overflow - (# s', _ #) -> (# s', 1# #) -- no overflow + (# s', 1## #) -> (# s', 0# #) -- underflow + (# s', _ #) -> (# s', 1# #) -- no underflow bignat_mul :: MutableWordArray# RealWorld ===================================== libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs ===================================== @@ -131,13 +131,13 @@ bignat_sub_word mwa wa b = go b 0# | 0## <- carry = case mwaArrayCopy# mwa i wa i (sz -# i) s of - s' -> (# s', 1# #) -- no overflow + s' -> (# s', 1# #) -- no underflow | True = case subWordC# (indexWordArray# wa i) carry of (# 0##, 0# #) | isTrue# (i ==# sz) -> case mwaShrink# mwa 1# s of - s' -> (# s', 1# #) -- no overflow + s' -> (# s', 1# #) -- no underflow (# l , c #) -> case mwaWrite# mwa i l s of s1 -> go (int2Word# c) (i +# 1#) s1 ===================================== libraries/ghc-bignum/src/GHC/Num/WordArray.hs ===================================== @@ -318,7 +318,7 @@ mwaAddInplaceWord# mwa i y s = case readWordArray# mwa i s of -- | Sub Word# inplace (at the specified offset) in the mwa with carry -- propagation. -- --- Return False# on overflow +-- Return False# on underflow mwaSubInplaceWord# :: MutableWordArray# d -> Int# @@ -328,9 +328,9 @@ mwaSubInplaceWord# mwaSubInplaceWord# mwa ii iw s1 = case mwaSize# mwa s1 of (# is, sz #) -> let - go _ 0## s = (# s, 1# #) -- no overflow + go _ 0## s = (# s, 1# #) -- no underflow go i y s - | isTrue# (i >=# sz) = (# s, 0# #) -- overflow + | isTrue# (i >=# sz) = (# s, 0# #) -- underflow | True = case readWordArray# mwa i s of (# s1, x #) -> let !(# l,h #) = subWordC# x y in case mwaWrite# mwa i l s1 of @@ -368,16 +368,16 @@ mwaTrimCompare k mwa wb s1 -- -- We don't trim the resulting array! -- --- Return False# on overflow. +-- Return False# on underflow. mwaSubInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> (# State# d, Bool# #) mwaSubInplaceArray mwa off wb = go (wordArraySize# wb -# 1#) where go i s - | isTrue# (i <# 0#) = (# s, 1# #) -- no overflow + | isTrue# (i <# 0#) = (# s, 1# #) -- no underflow | True = case mwaSubInplaceWord# mwa (off +# i) (indexWordArray# wb i) s of (# s2, 1# #) -> go (i -# 1#) s2 - (# s2, _ #) -> (# s2, 0# #) -- overflow + (# s2, _ #) -> (# s2, 0# #) -- underflow -- | Add array inplace (a the specified offset) in the mwa with carry propagation. -- @@ -398,19 +398,19 @@ mwaAddInplaceArray mwa off wb = go 0# 0## -- -- We don't trim the resulting array! -- --- Return False# on overflow. +-- Return False# on underflow. mwaSubInplaceMutableArray :: MutableWordArray# d -> Int# -> MutableWordArray# d -> State# d -> (# State# d, Bool# #) mwaSubInplaceMutableArray mwa off mwb s0 = case mwaSize# mwb s0 of (# s1, szB #) -> go (szB -# 1#) s1 where go i s - | isTrue# (i <# 0#) = (# s, 1# #) -- no overflow + | isTrue# (i <# 0#) = (# s, 1# #) -- no underflow | True = case readWordArray# mwb i s of (# s1, bi #) -> case mwaSubInplaceWord# mwa (off +# i) bi s1 of (# s2, 1# #) -> go (i -# 1#) s2 - (# s2, _ #) -> (# s2, 0# #) -- overflow + (# s2, _ #) -> (# s2, 0# #) -- underflow -- | Sub an array inplace and then trim zeroes -- ===================================== libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs ===================================== @@ -50,9 +50,22 @@ module GHC.Integer.GMP.Internals , zeroBigNat , oneBigNat + -- ** Conversions to/from 'BigNat' + + , wordToBigNat + , wordToBigNat2 + , bigNatToInt + , bigNatToWord + , indexBigNat# + , importBigNatFromByteArray + , exportBigNatToMutableByteArray + + -- ** 'BigNat' arithmetic operations , plusBigNat , plusBigNatWord + , minusBigNat + , minusBigNatWord , timesBigNat , timesBigNatWord , sqrBigNat @@ -112,6 +125,8 @@ import qualified GHC.Num.BigNat as B import qualified GHC.Num.Primitives as P import GHC.Types import GHC.Prim +import GHC.Exts (runRW#) +import Control.Exception {-# COMPLETE S#, Jp#, Jn# #-} @@ -199,6 +214,19 @@ plusBigNat (BN# a) (BN# b) = BN# (B.bigNatAdd a b) plusBigNatWord :: BigNat -> GmpLimb# -> BigNat plusBigNatWord (BN# a) w = BN# (B.bigNatAddWord# a w) +{-# DEPRECATED minusBigNat "Use bigNatSub instead" #-} +minusBigNat :: BigNat -> BigNat -> BigNat +minusBigNat (BN# a) (BN# b) = case B.bigNatSub a b of + (# () | #) -> throw Underflow + (# | r #) -> BN# r + +{-# DEPRECATED minusBigNatWord "Use bigNatSubWord# instead" #-} +minusBigNatWord :: BigNat -> GmpLimb# -> BigNat +minusBigNatWord (BN# a) b = case B.bigNatSubWord# a b of + (# () | #) -> throw Underflow + (# | r #) -> BN# r + + {-# DEPRECATED timesBigNat "Use bigNatMul instead" #-} timesBigNat :: BigNat -> BigNat -> BigNat timesBigNat (BN# a) (BN# b) = BN# (B.bigNatMul a b) @@ -344,3 +372,29 @@ exportBigNatToAddr :: BigNat -> Addr# -> Int# -> IO Word exportBigNatToAddr (BN# b) addr endian = IO \s -> case B.bigNatToAddr# b addr endian s of (# s', w #) -> (# s', W# w #) + +wordToBigNat :: Word# -> BigNat +wordToBigNat w = BN# (B.bigNatFromWord# w) + +wordToBigNat2 :: Word# -> Word# -> BigNat +wordToBigNat2 h l = BN# (B.bigNatFromWord2# h l) + +bigNatToInt :: BigNat -> Int# +bigNatToInt (BN# b) = B.bigNatToInt# b + +bigNatToWord :: BigNat -> Word# +bigNatToWord (BN# b) = B.bigNatToWord# b + +{-# DEPRECATED indexBigNat# "Use bigNatIndex# instead" #-} +indexBigNat# :: BigNat -> GmpSize# -> GmpLimb# +indexBigNat# (BN# b) i = B.bigNatIndex# b i + +{-# DEPRECATED importBigNatFromByteArray "Use bigNatFromByteArray# instead" #-} +importBigNatFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> BigNat +importBigNatFromByteArray ba off sz endian = case runRW# (B.bigNatFromByteArray# sz ba off endian) of + (# _, r #) -> BN# r + +{-# DEPRECATED exportBigNatToMutableByteArray "Use bigNatToMutableByteArray# instead" #-} +exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word +exportBigNatToMutableByteArray (BN# ba) mba off endian = IO (\s -> case B.bigNatToMutableByteArray# ba mba off endian s of + (# s', r #) -> (# s', W# r #)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf8bb9e7855f680d850dd3ba22af0402b6b2f6df...d5c3a027ec0536bd4c36d99b4101aedf55a2d7d1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/bf8bb9e7855f680d850dd3ba22af0402b6b2f6df...d5c3a027ec0536bd4c36d99b4101aedf55a2d7d1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 16:39:43 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 01 Sep 2020 12:39:43 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Fix FastString lexicographic ordering (fix #18562) Message-ID: <5f4e794f223b5_80bb1b300410193816@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - 30 changed files: - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Debug.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/CostCentre.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/SrcLoc.hs - compiler/GHC/Unit/Info.hs - compiler/GHC/Unit/Module/Name.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Unit/Types.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Encoding.hs - compiler/GHC/Utils/Outputable.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8a2568b7b64e5b9fca5b12df7da759de4db39ae...4b4fbc58d37d37457144014ef82bdd928de175df -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a8a2568b7b64e5b9fca5b12df7da759de4db39ae...4b4fbc58d37d37457144014ef82bdd928de175df You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 17:40:59 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Sep 2020 13:40:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T14422 Message-ID: <5f4e87ab3e874_80b3f8468dd997010199160@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T14422 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T14422 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 17:57:59 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Tue, 01 Sep 2020 13:57:59 -0400 Subject: [Git][ghc/ghc][wip/T14422] PmCheck: Look up COMPLETE pragmas by constituent ConLikes Message-ID: <5f4e8ba739adc_80b3f848e5e22281020089c@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14422 at Glasgow Haskell Compiler / GHC Commits: ff8ff6b0 by Sebastian Graf at 2020-09-01T19:57:47+02:00 PmCheck: Look up COMPLETE pragmas by constituent ConLikes By having a way to look up COMPLETE pragmas from one of their ConLikes, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. - - - - - 13 changed files: - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/Unique/DFM.hs - docs/users_guide/exts/pragmas.rst Changes: ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -146,7 +146,7 @@ module GHC.Driver.Types ( handleFlagWarnings, printOrThrowWarnings, -- * COMPLETE signature - CompleteMatch(..), CompleteMatchMap, + ConLikeSet, CompleteMatch(..), CompleteMatchMap, mkCompleteMatchMap, extendCompleteMatchMap, -- * Exstensible Iface fields @@ -2746,9 +2746,10 @@ data ExternalPackageState -- from all the external-package modules eps_ann_env :: !PackageAnnEnv, -- ^ The total 'AnnEnv' accumulated -- from all the external-package modules - eps_complete_matches :: !PackageCompleteMatchMap, + eps_complete_matches :: PackageCompleteMatchMap, -- ^ The total 'CompleteMatchMap' accumulated -- from all the external-package modules + -- may only be forced /after/ type-checking eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external -- packages, keyed off the module that declared them @@ -3203,36 +3204,47 @@ byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) ------------------------------------------- +type ConLikeSet = UniqDSet ConLike + -- | A list of conlikes which represents a complete pattern match. -- These arise from @COMPLETE@ signatures. - +-- -- See Note [Implementation of COMPLETE signatures] -data CompleteMatch = CompleteMatch { - completeMatchConLikes :: [Name] - -- ^ The ConLikes that form a covering family - -- (e.g. Nothing, Just) - , completeMatchTyCon :: Name - -- ^ The TyCon that they cover (e.g. Maybe) - } +data CompleteMatch + = CompleteMatch + { completeMatchName :: !Name + -- ^ A Name for this @COMPLETE@ sig. We only need the 'Unique', but the name + -- is needed for serialising to interface files. Thus always a proxy name + -- like @$CL_a1bz at . + , completeMatchConLikes :: ConLikeSet + -- ^ The ConLikes that form a covering family (e.g. Nothing, Just) + -- Needs to be lazy, because it's lazily loaded from interface files and only + -- type-checked after we already accessed 'completeMatchName'. + } instance Outputable CompleteMatch where - ppr (CompleteMatch cl ty) = text "CompleteMatch:" <+> ppr cl - <+> dcolon <+> ppr ty - --- | A map keyed by the 'completeMatchTyCon' which has type Name. + ppr (CompleteMatch n cls) = text "CompleteMatch(" <> ppr n <> text "):" + <+> ppr cls +-- | A map associating 'ConLike's to 'CompleteMatch'es in which they +-- occur. +-- -- See Note [Implementation of COMPLETE signatures] -type CompleteMatchMap = UniqFM Name [CompleteMatch] +type CompleteMatchMap = UniqDFM ConLike [CompleteMatch] mkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap -mkCompleteMatchMap = extendCompleteMatchMap emptyUFM +mkCompleteMatchMap = extendCompleteMatchMap emptyUDFM extendCompleteMatchMap :: CompleteMatchMap -> [CompleteMatch] -> CompleteMatchMap -extendCompleteMatchMap = foldl' insertMatch +extendCompleteMatchMap = foldl' go_over_cls where - insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap - insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c] + go_over_cls :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap + go_over_cls udfm c@(CompleteMatch _ cls) = + foldl' (go_over_cl c) udfm (uniqDSetToList cls) + go_over_cl :: CompleteMatch -> CompleteMatchMap -> ConLike -> CompleteMatchMap + go_over_cl c udfm cl = + addToUDFM_C (\old _new -> c:old) udfm cl [c] {- Note [Implementation of COMPLETE signatures] ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -88,7 +88,7 @@ import GHC.Driver.Ppr import GHC.Utils.Error import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Types.Unique.FM ( lookupWithDefaultUFM_Directly ) +import GHC.Types.Unique.DFM ( lookupWithDefaultUDFM ) import GHC.Types.Literal ( mkLitString ) import GHC.Types.CostCentre.State @@ -534,14 +534,12 @@ dsGetMetaEnv :: DsM (NameEnv DsMetaVal) dsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) } -- | The @COMPLETE@ pragmas provided by the user for a given `TyCon`. -dsGetCompleteMatches :: TyCon -> DsM [CompleteMatch] -dsGetCompleteMatches tc = do +dsGetCompleteMatches :: ConLike -> DsM [CompleteMatch] +dsGetCompleteMatches cl = do eps <- getEps env <- getGblEnv - -- We index into a UniqFM from Name -> elt, for tyCon it holds that - -- getUnique (tyConName tc) == getUnique tc. So we lookup using the - -- unique directly instead. - let lookup_completes ufm = lookupWithDefaultUFM_Directly ufm [] (getUnique tc) + let lookup_completes :: CompleteMatchMap -> [CompleteMatch] + lookup_completes udfm = lookupWithDefaultUDFM udfm [] cl eps_matches_list = lookup_completes $ eps_complete_matches eps env_matches_list = lookup_completes $ ds_complete_matches env return $ eps_matches_list ++ env_matches_list ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -66,7 +66,7 @@ import GHC.Core.TyCo.Rep import GHC.Core.Type import GHC.Tc.Solver (tcNormalise, tcCheckSatisfiability) import GHC.Core.Unify (tcMatchTy) -import GHC.Tc.Types (completeMatchConLikes) +import GHC.Tc.Types (CompleteMatch(..)) import GHC.Core.Coercion import GHC.Utils.Monad hiding (foldlM) import GHC.HsToCore.Monad hiding (foldlM) @@ -80,7 +80,6 @@ import Data.Bifunctor (second) import Data.Either (partitionEithers) import Data.Foldable (foldlM, minimumBy, toList) import Data.List (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ord (comparing) import qualified Data.Semigroup as Semigroup import Data.Tuple (swap) @@ -105,11 +104,57 @@ mkPmId ty = getUniqueM >>= \unique -> ----------------------------------------------- -- * Caching possible matches of a COMPLETE set -markMatched :: ConLike -> PossibleMatches -> PossibleMatches -markMatched _ NoPM = NoPM -markMatched con (PM ms) = PM (del_one_con con <$> ms) - where - del_one_con = flip delOneFromUniqDSet +-- | A pseudo-'CompleteMatch' for the vanilla complete set of the data defn of +-- the given 'DataCon'. +-- Ex.: @vanillaCompleteMatchDC 'Just' ==> ("Maybe", {'Just','Nothing'})@ +vanillaCompleteMatchDC :: DataCon -> CompleteMatch +vanillaCompleteMatchDC dc = + expectJust "vanillaCompleteMatchDC" $ vanillaCompleteMatchTC (dataConTyCon dc) + +-- | A pseudo-'CompleteMatch' for the vanilla complete set of the given data +-- 'TyCon'. +-- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ +vanillaCompleteMatchTC :: TyCon -> Maybe CompleteMatch +vanillaCompleteMatchTC tc = + let -- | TYPE acts like an empty data type on the term-level (#14086), but + -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a + -- special case. + mb_dcs | tc == tYPETyCon = Just [] + | otherwise = tyConDataCons_maybe tc + -- | Using the Name of the TyCon instead of a Name of an actual + -- CompleteMatches here is OK, since they're in the same Occ NameSpace + -- and thus can't clash. + nm = getName tc + in CompleteMatch nm . mkUniqDSet . map RealDataCon <$> mb_dcs + +-- | Adds the 'CompleteMatches' that the 'ConLike' is part of to the +-- 'ResidualCompleteMatches', if not already present. We can identify two +-- 'CompleteMatches' by their 'Name', which conveniently is the index of +-- the Map in 'ResidualCompleteMatches'. +addConLikeMatches :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addConLikeMatches cl (RCM cmpls) = do + tracePm "get cmpl" empty + cs <- dsGetCompleteMatches cl + -- Add the vanilla COMPLETE set from the data defn + let cs' = case cl of + RealDataCon dc -> vanillaCompleteMatchDC dc : cs + _ -> cs + pure $ RCM $ addListToUDFM_C (\old _new -> old) cmpls + [ (n, c) | CompleteMatch n c <- cs' ] + +-- | Adds the /vanilla/ 'CompleteMatches' of the data 'TyCon' to the +-- 'ResidualCompleteMatches', if not already present. +-- Like 'addConLikeMatches', but based on the data 'TyCon' and adds +-- only the vanilla COMPLETE set. +addTyConMatches :: TyCon -> ResidualCompleteMatches -> ResidualCompleteMatches +addTyConMatches tc rcm@(RCM cmpls) = case vanillaCompleteMatchTC tc of + Nothing -> rcm + Just (CompleteMatch n c) -> RCM $ addToUDFM_C (\old _new -> old) cmpls n c + +markMatched :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +markMatched cl rcm = do + RCM cmpl <- addConLikeMatches cl rcm + pure $ RCM (flip delOneFromUniqDSet cl <$> cmpl) --------------------------------------------------- -- * Instantiating constructors, types and evidence @@ -492,7 +537,7 @@ tyOracle (TySt inert) cts -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. Doesn't bother calling out to the type oracle if the bag of new type --- constraints was empty. Will only recheck 'PossibleMatches' in the term oracle +-- constraints was empty. Will only recheck 'ResidualCompleteMatches' in the term oracle -- for emptiness if the first argument is 'True'. tyIsSatisfiable :: Bool -> Bag PredType -> SatisfiabilityCheck tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \nabla -> @@ -624,13 +669,16 @@ tmIsSatisfiable new_tm_cs = SC $ \nabla -> runMaybeT $ foldlM addTmCt nabla new_ ----------------------- -- * Looking up VarInfo +emptyRCM :: ResidualCompleteMatches +emptyRCM = RCM emptyUDFM + emptyVarInfo :: Id -> VarInfo -- We could initialise @bot@ to @Just False@ in case of an unlifted type here, -- but it's cleaner to let the user of the constraint solver take care of this. -- After all, there are also strict fields, the unliftedness of which isn't -- evident in the type. So treating unlifted types here would never be -- sufficient anyway. -emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot NoPM +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot emptyRCM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' @@ -656,85 +704,6 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of | isNewDataCon dc = Just y go _ = Nothing -initPossibleMatches :: TyState -> VarInfo -> DsM VarInfo -initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do - -- New evidence might lead to refined info on ty, in turn leading to discovery - -- of a COMPLETE set. - res <- pmTopNormaliseType ty_st ty - let ty' = normalisedSourceType res - case splitTyConApp_maybe ty' of - Nothing -> pure vi{ vi_ty = ty' } - Just (tc, [_]) - | tc == tYPETyCon - -- TYPE acts like an empty data type on the term-level (#14086), but - -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a - -- special case. - -> pure vi{ vi_ty = ty', vi_cache = PM (pure emptyUniqDSet) } - Just (tc, tc_args) -> do - -- See Note [COMPLETE sets on data families] - (tc_rep, tc_fam) <- case tyConFamInst_maybe tc of - Just (tc_fam, _) -> pure (tc, tc_fam) - Nothing -> do - env <- dsGetFamInstEnvs - let (tc_rep, _tc_rep_args, _co) = tcLookupDataFamInst env tc tc_args - pure (tc_rep, tc) - -- Note that the common case here is tc_rep == tc_fam - let mb_rdcs = map RealDataCon <$> tyConDataCons_maybe tc_rep - let rdcs = maybeToList mb_rdcs - -- NB: tc_fam, because COMPLETE sets are associated with the parent data - -- family TyCon - pragmas <- dsGetCompleteMatches tc_fam - let fams = mapM dsLookupConLike . completeMatchConLikes - pscs <- mapM fams pragmas - -- pprTrace "initPossibleMatches" (ppr ty $$ ppr ty' $$ ppr tc_rep <+> ppr tc_fam <+> ppr tc_args $$ ppr (rdcs ++ pscs)) (return ()) - case NonEmpty.nonEmpty (rdcs ++ pscs) of - Nothing -> pure vi{ vi_ty = ty' } -- Didn't find any COMPLETE sets - Just cs -> pure vi{ vi_ty = ty', vi_cache = PM (mkUniqDSet <$> cs) } -initPossibleMatches _ vi = pure vi - -{- Note [COMPLETE sets on data families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -User-defined COMPLETE sets involving data families are attached to the family -TyCon, whereas the built-in COMPLETE set is attached to a data family instance's -representation TyCon. This matters for COMPLETE sets involving both DataCons -and PatSyns (from #17207): - - data family T a - data family instance T () = A | B - pattern C = B - {-# COMPLETE A, C #-} - f :: T () -> () - f A = () - f C = () - -The match on A is actually wrapped in a CoPat, matching impedance between T () -and its representation TyCon, which we translate as - at x | let y = x |> co, A <- y@ in PmCheck. - -Which TyCon should we use for looking up the COMPLETE set? The representation -TyCon from the match on A would only reveal the built-in COMPLETE set, while the -data family TyCon would only give the user-defined one. But when initialising -the PossibleMatches for a given Type, we want to do so only once, because -merging different COMPLETE sets after the fact is very complicated and possibly -inefficient. - -So in fact, we just *drop* the coercion arising from the CoPat when handling -handling the constraint @y ~ x |> co@ in addCoreCt, just equating @y ~ x at . -We then handle the fallout in initPossibleMatches, which has to get a hand at -both the representation TyCon tc_rep and the parent data family TyCon tc_fam. -It considers three cases after having established that the Type is a TyConApp: - -1. The TyCon is a vanilla data type constructor -2. The TyCon is tc_rep -3. The TyCon is tc_fam - -1. is simple and subsumed by the handling of the other two. -We check for case 2. by 'tyConFamInst_maybe' and get the tc_fam out. -Otherwise (3.), we try to lookup the data family instance at that particular -type to get out the tc_rep. In case 1., this will just return the original -TyCon, so tc_rep = tc_fam afterwards. --} - ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -897,11 +866,7 @@ addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do - -- For good performance, it's important to initPossibleMatches here. - -- Otherwise we can't mark nalt as matched later on, incurring unnecessary - -- inhabitation tests for nalt. - vi@(VI _ pos neg _ pm) <- lift $ initPossibleMatches (nabla_ty_st nabla) - (lookupVarInfo ts x) + let vi@(VI _ pos neg _ rcm) = lookupVarInfo ts x -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt (cl, _tvs, _args) = eqPmAltCon cl nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -917,9 +882,11 @@ addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor vi2 <- case nalt of - PmAltConLike cl - -> ensureInhabited nabla vi1{ vi_cache = markMatched cl pm } - _ -> pure vi1 + PmAltConLike cl -> do + rcm' <- lift (markMatched cl rcm) + ensureInhabited nabla vi1{ vi_cache = rcm' } + _ -> + pure vi1 pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } hasRequiredTheta :: PmAltCon -> Bool @@ -1007,17 +974,16 @@ ensureInhabited :: Nabla -> VarInfo -> MaybeT DsM VarInfo ensureInhabited nabla vi = case vi_bot vi of MaybeBot -> pure vi -- The |-Bot rule from the paper IsBot -> pure vi - IsNotBot -> lift (initPossibleMatches (nabla_ty_st nabla) vi) >>= inst_complete_sets + IsNotBot -> inst_complete_sets vi where -- | This is the |-Inst rule from the paper (section 4.5). Tries to -- find an inhabitant in every complete set by instantiating with one their -- constructors. If there is any complete set where we can't find an -- inhabitant, the whole thing is uninhabited. inst_complete_sets :: VarInfo -> MaybeT DsM VarInfo - inst_complete_sets vi at VI{ vi_cache = NoPM } = pure vi - inst_complete_sets vi at VI{ vi_cache = PM ms } = do + inst_complete_sets vi at VI{ vi_cache = RCM ms } = do ms <- traverse (\cs -> inst_complete_set vi cs (uniqDSetToList cs)) ms - pure vi{ vi_cache = PM ms } + pure vi{ vi_cache = RCM ms } inst_complete_set :: VarInfo -> ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet -- (inst_complete_set cs cls) iterates over cls, deleting from cs @@ -1586,8 +1552,12 @@ provideEvidence = go Just (y, newty_nabla) -> do -- Pick a COMPLETE set and instantiate it (n at max). Take care of ⊥. let vi = lookupVarInfo (nabla_tm_st newty_nabla) y - vi <- initPossibleMatches (nabla_ty_st newty_nabla) vi - mb_cls <- pickMinimalCompleteSet newty_nabla (vi_cache vi) + res <- pmTopNormaliseType (nabla_ty_st newty_nabla) (vi_ty vi) + let y_ty' = normalisedSourceType res + let rcm = case splitTyConApp_maybe y_ty' of + Nothing -> vi_cache vi + Just (tc, _) -> addTyConMatches tc (vi_cache vi) + mb_cls <- pickMinimalCompleteSet newty_nabla rcm case uniqDSetToList <$> mb_cls of Just cls@(_:_) -> instantiate_cons y core_ty xs n newty_nabla cls Just [] | vi_bot vi == IsNotBot -> pure [] @@ -1631,12 +1601,13 @@ provideEvidence = go other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls pure (con_nablas ++ other_cons_nablas) -pickMinimalCompleteSet :: Nabla -> PossibleMatches -> DsM (Maybe ConLikeSet) -pickMinimalCompleteSet _ NoPM = pure Nothing +pickMinimalCompleteSet :: Nabla -> ResidualCompleteMatches -> DsM (Maybe ConLikeSet) +pickMinimalCompleteSet _ (RCM clss) + | null clss = pure Nothing -- TODO: First prune sets with type info in nabla. But this is good enough for -- now and less costly. See #17386. -pickMinimalCompleteSet _ (PM clss) = do - tracePm "pickMinimalCompleteSet" (ppr $ NonEmpty.toList clss) +pickMinimalCompleteSet _ rcm@(RCM clss) = do + tracePm "pickMinimalCompleteSet" (ppr rcm) pure (Just (minimumBy (comparing sizeUniqDSet) clss)) -- | Finds a representant of the semantic equality class of the given @e at . ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -24,8 +24,8 @@ module GHC.HsToCore.PmCheck.Types ( literalToPmLit, negatePmLit, overloadPmLit, pmLitAsStringLit, coreExprAsPmLit, - -- * Caching partially matched COMPLETE sets - ConLikeSet, PossibleMatches(..), + -- * Caching residual COMPLETE sets + ConLikeSet, ResidualCompleteMatches(..), -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -69,10 +69,10 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) import Data.Foldable (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ratio import qualified Data.Semigroup as Semi @@ -415,21 +415,15 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show -type ConLikeSet = UniqDSet ConLike +-- | A data type that caches for the 'VarInfo' of @x@ the results of querying +-- 'completeMatchConLikes' for all the @K@ for which we know @x /~ K@ and then +-- striking out all occurrences of those @K at s from these sets. +-- For motivation, see Section 5.3 in Lower Your Guards. +newtype ResidualCompleteMatches = RCM (UniqDFM Name ConLikeSet) -- 'Name of the 'CompleteMatch' --- | A data type caching the results of 'completeMatchConLikes' with support for --- deletion of constructors that were already matched on. -data PossibleMatches - = PM (NonEmpty.NonEmpty ConLikeSet) - -- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE set - -- 'NonEmpty' because the empty case would mean that the type has no COMPLETE - -- set at all, for which we have 'NoPM'. - | NoPM - -- ^ No COMPLETE set for this type (yet). Think of overloaded literals. - -instance Outputable PossibleMatches where - ppr (PM cs) = ppr (NonEmpty.toList cs) - ppr NoPM = text "" +instance Outputable ResidualCompleteMatches where + -- formats as "[{Nothing,Just},{P,Q}]" + ppr (RCM cs) = ppr (map snd (udfmToList cs)) -- | Either @Indirect x@, meaning the value is represented by that of @x@, or -- an @Entry@ containing containing the actual value it represents. @@ -516,7 +510,7 @@ data TmState -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". --- Also caches the type ('vi_ty'), the 'PossibleMatches' of a COMPLETE set +-- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set -- ('vi_cache'). -- -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". @@ -559,7 +553,7 @@ data VarInfo -- * 'IsBot': @x ~ ⊥@ -- * 'IsNotBot': @x ≁ ⊥@ - , vi_cache :: !PossibleMatches + , vi_cache :: !ResidualCompleteMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of -- possible constructors of each COMPLETE set. So, if it's not in here, we -- can't possibly match on it. Complementary to 'vi_neg'. We still need it ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -70,6 +70,7 @@ import GHC.Data.Maybe import GHC.Utils.Error import GHC.Driver.Finder import GHC.Types.Unique.FM +import GHC.Types.Unique.DFM import GHC.Types.SrcLoc import GHC.Utils.Outputable as Outputable import GHC.Iface.Binary @@ -1037,9 +1038,8 @@ initExternalPackageState home_unit eps_fam_inst_env = emptyFamInstEnv, eps_rule_base = mkRuleBase builtinRules', -- Initialise the EPS rule pool with the built-in rules - eps_mod_fam_inst_env - = emptyModuleEnv, - eps_complete_matches = emptyUFM, + eps_mod_fam_inst_env = emptyModuleEnv, + eps_complete_matches = emptyUDFM, eps_ann_env = emptyAnnEnv, eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0 , n_insts_in = 0, n_insts_out = 0 ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -57,6 +57,7 @@ import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Name.Env import GHC.Types.Name.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Utils.Error import GHC.Utils.Outputable @@ -323,7 +324,8 @@ mkIface_ hsc_env -} mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch -mkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc +mkIfaceCompleteSig (CompleteMatch n cls) = + IfaceCompleteMatch n (map conLikeName (uniqDSetToList cls)) {- ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -324,7 +324,7 @@ data IfaceAnnotation type IfaceAnnTarget = AnnTarget OccName -data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName +data IfaceCompleteMatch = IfaceCompleteMatch IfExtName [IfExtName] instance Outputable IfaceCompleteMatch where ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -67,6 +67,7 @@ import GHC.Types.Name.Set import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Unit.Module import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet ( mkUniqDSet ) import GHC.Types.Unique.Supply import GHC.Utils.Outputable import GHC.Data.Maybe @@ -1151,7 +1152,10 @@ tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch] tcIfaceCompleteSigs = mapM tcIfaceCompleteSig tcIfaceCompleteSig :: IfaceCompleteMatch -> IfL CompleteMatch -tcIfaceCompleteSig (IfaceCompleteMatch ms t) = return (CompleteMatch ms t) +tcIfaceCompleteSig (IfaceCompleteMatch u ms) = + CompleteMatch u . mkUniqDSet <$> mapM (forkM doc . tcIfaceConLike) ms + where + doc = text "COMPLETE sig" <+> ppr ms {- ************************************************************************ @@ -1760,7 +1764,13 @@ tcIfaceDataCon :: Name -> IfL DataCon tcIfaceDataCon name = do { thing <- tcIfaceGlobal name ; case thing of AConLike (RealDataCon dc) -> return dc - _ -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) } + _ -> pprPanic "tcIfaceDataCon" (ppr name$$ ppr thing) } + +tcIfaceConLike :: Name -> IfL ConLike +tcIfaceConLike name = do { thing <- tcIfaceGlobal name + ; case thing of + AConLike cl -> return cl + _ -> pprPanic "tcIfaceConLike" (ppr name$$ ppr thing) } tcIfaceExtId :: Name -> IfL Id tcIfaceExtId name = do { thing <- tcIfaceGlobal name ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -44,9 +44,8 @@ import GHC.Tc.Utils.TcMType import GHC.Core.Multiplicity import GHC.Core.FamInstEnv( normaliseType ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs ) -import GHC.Core.TyCon import GHC.Tc.Utils.TcType -import GHC.Core.Type (mkStrLitTy, tidyOpenType, splitTyConApp_maybe, mkCastTy) +import GHC.Core.Type (mkStrLitTy, tidyOpenType, mkCastTy) import GHC.Builtin.Types.Prim import GHC.Builtin.Types( mkBoxedTupleTy ) import GHC.Types.Id @@ -69,9 +68,9 @@ import GHC.Utils.Panic import GHC.Builtin.Names( ipClassName ) import GHC.Tc.Validity (checkValidType) import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Unique.Set import qualified GHC.LanguageExtensions as LangExt -import GHC.Core.ConLike import Control.Monad import Data.Foldable (find) @@ -197,112 +196,23 @@ tcTopBinds binds sigs -- The top level bindings are flattened into a giant -- implicitly-mutually-recursive LHsBinds - --- Note [Typechecking Complete Matches] --- Much like when a user bundled a pattern synonym, the result types of --- all the constructors in the match pragma must be consistent. --- --- If we allowed pragmas with inconsistent types then it would be --- impossible to ever match every constructor in the list and so --- the pragma would be useless. - - - - - --- This is only used in `tcCompleteSig`. We fold over all the conlikes, --- this accumulator keeps track of the first `ConLike` with a concrete --- return type. After fixing the return type, all other constructors with --- a fixed return type must agree with this. --- --- The fields of `Fixed` cache the first conlike and its return type so --- that we can compare all the other conlikes to it. The conlike is --- stored for error messages. --- --- `Nothing` in the case that the type is fixed by a type signature -data CompleteSigType = AcceptAny | Fixed (Maybe ConLike) TyCon - tcCompleteSigs :: [LSig GhcRn] -> TcM [CompleteMatch] tcCompleteSigs sigs = let - doOne :: Sig GhcRn -> TcM (Maybe CompleteMatch) - doOne c@(CompleteMatchSig _ _ lns mtc) - = fmap Just $ do - addErrCtxt (text "In" <+> ppr c) $ - case mtc of - Nothing -> infer_complete_match - Just tc -> check_complete_match tc - where - - checkCLTypes acc = foldM checkCLType (acc, []) (unLoc lns) - - infer_complete_match = do - (res, cls) <- checkCLTypes AcceptAny - case res of - AcceptAny -> failWithTc ambiguousError - Fixed _ tc -> return $ mkMatch cls tc - - check_complete_match tc_name = do - ty_con <- tcLookupLocatedTyCon tc_name - (_, cls) <- checkCLTypes (Fixed Nothing ty_con) - return $ mkMatch cls ty_con - - mkMatch :: [ConLike] -> TyCon -> CompleteMatch - mkMatch cls ty_con = CompleteMatch { - -- foldM is a left-fold and will have accumulated the ConLikes in - -- the reverse order. foldrM would accumulate in the correct order, - -- but would type-check the last ConLike first, which might also be - -- confusing from the user's perspective. Hence reverse here. - completeMatchConLikes = reverse (map conLikeName cls), - completeMatchTyCon = tyConName ty_con - } + doOne :: (Int, LSig GhcRn) -> TcM (Maybe CompleteMatch) + -- We don't need to "type-check" COMPLETE signatures anymore; if their + -- combinations are invalid it will be found so at match sites. Hence we + -- keep '_mtc' only for backwards compatibility. + doOne (n, L loc c@(CompleteMatchSig _ext _src_txt (L _ ns) _mtc)) + = fmap Just $ setSrcSpan loc $ addErrCtxt (text "In" <+> ppr c) $ + CompleteMatch <$> newCompleteMatchName n loc + <*> (mkUniqDSet <$> mapM (addLocM tcLookupConLike) ns) doOne _ = return Nothing - ambiguousError :: SDoc - ambiguousError = - text "A type signature must be provided for a set of polymorphic" - <+> text "pattern synonyms." - - - -- See note [Typechecking Complete Matches] - checkCLType :: (CompleteSigType, [ConLike]) -> Located Name - -> TcM (CompleteSigType, [ConLike]) - checkCLType (cst, cs) n = do - cl <- addLocM tcLookupConLike n - let (_,_,_,_,_,_, res_ty) = conLikeFullSig cl - res_ty_con = fst <$> splitTyConApp_maybe res_ty - case (cst, res_ty_con) of - (AcceptAny, Nothing) -> return (AcceptAny, cl:cs) - (AcceptAny, Just tc) -> return (Fixed (Just cl) tc, cl:cs) - (Fixed mfcl tc, Nothing) -> return (Fixed mfcl tc, cl:cs) - (Fixed mfcl tc, Just tc') -> - if tc == tc' - then return (Fixed mfcl tc, cl:cs) - else case mfcl of - Nothing -> - addErrCtxt (text "In" <+> ppr cl) $ - failWithTc typeSigErrMsg - Just cl -> failWithTc (errMsg cl) - where - typeSigErrMsg :: SDoc - typeSigErrMsg = - text "Couldn't match expected type" - <+> quotes (ppr tc) - <+> text "with" - <+> quotes (ppr tc') - - errMsg :: ConLike -> SDoc - errMsg fcl = - text "Cannot form a group of complete patterns from patterns" - <+> quotes (ppr fcl) <+> text "and" <+> quotes (ppr cl) - <+> text "as they match different type constructors" - <+> parens (quotes (ppr tc) - <+> text "resp." - <+> quotes (ppr tc')) -- For some reason I haven't investigated further, the signatures come in -- backwards wrt. declaration order. So we reverse them here, because it makes -- a difference for incomplete match suggestions. - in mapMaybeM (addLocM doOne) (reverse sigs) -- process in declaration order + in mapMaybeM doOne $ zip [1..] $ reverse sigs tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id] -- A hs-boot file has only one BindGroup, and it only has type ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -64,8 +64,8 @@ module GHC.Tc.Utils.Env( topIdLvl, isBrackStage, -- New Ids - newDFunName, newFamInstTyConName, - newFamInstAxiomName, + newDFunName, newCompleteMatchName, + newFamInstTyConName, newFamInstAxiomName, mkStableIdFromString, mkStableIdFromName, mkWrapperName ) where @@ -1012,6 +1012,12 @@ newDFunName clas tys loc ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot) ; newGlobalBinder mod dfun_occ loc } +newCompleteMatchName :: Int -> SrcSpan -> TcM Name +newCompleteMatchName n loc + = do { mod <- getModule + ; let occ = mkCompleteMatchOcc (show n) + ; newGlobalBinder mod occ loc } + newFamInstTyConName :: Located Name -> [Type] -> TcM Name newFamInstTyConName (L loc name) tys = mk_fam_inst_name id loc name [tys] ===================================== compiler/GHC/Types/Name/Occurrence.hs ===================================== @@ -70,6 +70,7 @@ module GHC.Types.Name.Occurrence ( mkInstTyCoOcc, mkEqPredCoOcc, mkRecFldSelOcc, mkTyConRepOcc, + mkCompleteMatchOcc, -- ** Deconstruction occNameFS, occNameString, occNameSpace, @@ -652,6 +653,9 @@ mkGen1R = mk_simple_deriv tcName "Rep1_" mkRecFldSelOcc :: String -> OccName mkRecFldSelOcc s = mk_deriv varName "$sel" [fsLit s] +mkCompleteMatchOcc :: String -> OccName +mkCompleteMatchOcc s = mk_deriv tcName "$CM" [fsLit s] + mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName mk_simple_deriv sp px occ = mk_deriv sp px [occNameFS occ] ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Types.Unique.DFM ( addToUDFM_C_Directly, addToUDFM_Directly, addListToUDFM, + addListToUDFM_C, delFromUDFM, delListFromUDFM, adjustUDFM, @@ -41,6 +42,7 @@ module GHC.Types.Unique.DFM ( plusUDFM, plusUDFM_C, lookupUDFM, lookupUDFM_Directly, + lookupWithDefaultUDFM, lookupWithDefaultUDFM_Directly, elemUDFM, foldUDFM, eltsUDFM, @@ -68,6 +70,7 @@ import GHC.Prelude import GHC.Types.Unique ( Uniquable(..), Unique, getKey ) import GHC.Utils.Outputable +import GHC.Data.Maybe ( orElse ) import qualified Data.IntMap as M import Data.Data @@ -206,6 +209,10 @@ addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) addListToUDFM_Directly :: UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v) +addListToUDFM_C + :: Uniquable key => (elt -> elt -> elt) -> UniqDFM key elt -> [(key,elt)] -> UniqDFM key elt +addListToUDFM_C f = foldl' (\m (k, v) -> addToUDFM_C f m k v) + addListToUDFM_Directly_C :: (elt -> elt -> elt) -> UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_C_Directly f m k v) @@ -274,6 +281,12 @@ lookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m lookupUDFM_Directly :: UniqDFM key elt -> Unique -> Maybe elt lookupUDFM_Directly (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey k) m +lookupWithDefaultUDFM :: Uniquable key => UniqDFM key elt -> elt -> key -> elt +lookupWithDefaultUDFM m v k = lookupUDFM m k `orElse` v + +lookupWithDefaultUDFM_Directly :: UniqDFM key elt -> elt -> Unique -> elt +lookupWithDefaultUDFM_Directly m v k = lookupUDFM_Directly m k `orElse` v + elemUDFM :: Uniquable key => key -> UniqDFM key elt -> Bool elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m ===================================== docs/users_guide/exts/pragmas.rst ===================================== @@ -887,29 +887,6 @@ modules. ``COMPLETE`` pragmas should be thought of as asserting a universal truth about a set of patterns and as a result, should not be used to silence context specific incomplete match warnings. -When specifying a ``COMPLETE`` pragma, the result types of all patterns must -be consistent with each other. This is a sanity check as it would be impossible -to match on all the patterns if the types were inconsistent. - -The result type must also be unambiguous. Usually this can be inferred but -when all the pattern synonyms in a group are polymorphic in the constructor -the user must provide a type signature. :: - - class LL f where - go :: f a -> () - - instance LL [] where - go _ = () - - pattern T :: LL f => f a - pattern T <- (go -> ()) - - {-# COMPLETE T :: [] #-} - - -- No warning - foo :: [a] -> Int - foo T = 5 - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff8ff6b0e2db6740d0c2ac4cdd5b439569f8b47b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ff8ff6b0e2db6740d0c2ac4cdd5b439569f8b47b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 18:34:23 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Sep 2020 14:34:23 -0400 Subject: [Git][ghc/ghc][wip/stgMalloc] rts: Consistently use stgMallocBytes instead of malloc Message-ID: <5f4e942fb1cc2_80b3f83d0b7b16c10205848@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/stgMalloc at Glasgow Haskell Compiler / GHC Commits: eca239ac by GHC GitLab CI at 2020-09-01T14:33:55-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 5 changed files: - rts/linker/PEi386.c - rts/win32/IOManager.c - rts/win32/OSThreads.c - rts/win32/WorkQueue.c - rts/xxhash.c Changes: ===================================== rts/linker/PEi386.c ===================================== @@ -735,7 +735,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) error: stgFree(buf); - char* errormsg = malloc(sizeof(char) * 80); + char* errormsg = stgMallocBytes(sizeof(char) * 80, "addDLL_PEi386"); snprintf(errormsg, 80, "addDLL: %" PATH_FMT " or dependencies not loaded. (Win32 error %lu)", dll_name, GetLastError()); /* LoadLibrary failed; return a ptr to the error msg. */ return errormsg; @@ -745,7 +745,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) { const unsigned int init_buf_size = 1024; unsigned int bufsize = init_buf_size; - wchar_t* result = malloc(sizeof(wchar_t) * bufsize); + wchar_t* result = stgMallocBytes(sizeof(wchar_t) * bufsize, "findSystemLibrary_PEi386"); DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL); if (wResult > bufsize) { @@ -755,7 +755,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) if (!wResult) { - free(result); + stgFree(result); return NULL; } @@ -773,7 +773,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) int bufsize = init_buf_size; // Make sure the path is an absolute path - WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* abs_path = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(1)"); DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL); if (!wResult){ IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError())); @@ -791,7 +791,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) else { warnMissingKBLibraryPaths(); - WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* str = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(2)"); wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); if (wResult > init_buf_size) { @@ -804,7 +804,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) } bufsize = wResult + 2 + pathlen(abs_path); - wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize); + wchar_t* newPath = stgMallocBytes(sizeof(wchar_t) * bufsize, "addLibrarySearchPath_PEi386(3)"); wcscpy(newPath, abs_path); wcscat(newPath, L";"); @@ -813,19 +813,19 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); } - free(newPath); - free(abs_path); + stgFree(newPath); + stgFree(abs_path); return str; } if (!result) { sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); - free(abs_path); + stgFree(abs_path); return NULL; } - free(abs_path); + stgFree(abs_path); return result; } ===================================== rts/win32/IOManager.c ===================================== @@ -265,7 +265,7 @@ IOWorkerProc(PVOID param) } // Free the WorkItem DeregisterWorkItem(iom,work); - free(work); + stgFree(work); } else { fprintf(stderr, "unable to fetch work; fatal.\n"); fflush(stderr); @@ -321,7 +321,7 @@ StartIOManager(void) wq = NewWorkQueue(); if ( !wq ) return false; - ioMan = (IOManagerState*)malloc(sizeof(IOManagerState)); + ioMan = (IOManagerState*)stgMallocBytes(sizeof(IOManagerState), "StartIOManager"); if (!ioMan) { FreeWorkQueue(wq); @@ -332,7 +332,7 @@ StartIOManager(void) hExit = CreateEvent ( NULL, true, false, NULL ); if ( !hExit ) { FreeWorkQueue(wq); - free(ioMan); + stgFree(ioMan); return false; } @@ -440,8 +440,7 @@ AddIORequest ( int fd, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return 0; + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddIORequest"); unsigned int reqID = ioMan->requestID++; @@ -471,8 +470,7 @@ AddDelayRequest ( HsInt usecs, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return false; + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddDelayRequest"); unsigned int reqID = ioMan->requestID++; @@ -498,7 +496,7 @@ AddProcRequest ( void* proc, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddProcRequest"); if (!wItem) return false; unsigned int reqID = ioMan->requestID++; @@ -542,7 +540,7 @@ void ShutdownIOManager ( bool wait_threads ) barf("timeEndPeriod failed"); } - free(ioMan); + stgFree(ioMan); ioMan = NULL; } } ===================================== rts/win32/OSThreads.c ===================================== @@ -171,19 +171,19 @@ void freeThreadingResources (void) { if (cpuGroupCache) { - free(cpuGroupCache); + stgFree(cpuGroupCache); cpuGroupCache = NULL; } if (cpuGroupCumulativeCache) { - free(cpuGroupCumulativeCache); + stgFree(cpuGroupCumulativeCache); cpuGroupCumulativeCache = NULL; } if (cpuGroupDistCache) { - free(cpuGroupDistCache); + stgFree(cpuGroupDistCache); cpuGroupDistCache = NULL; } } @@ -240,7 +240,7 @@ getProcessorsDistribution (void) if (!cpuGroupDistCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupDistCache = malloc(n_groups * sizeof(uint8_t)); + cpuGroupDistCache = stgMallocBytes(n_groups * sizeof(uint8_t), "getProcessorsDistribution"); memset(cpuGroupDistCache, MAXIMUM_PROCESSORS, n_groups * sizeof(uint8_t)); for (int i = 0; i < n_groups; i++) @@ -265,7 +265,7 @@ getProcessorsCumulativeSum(void) if (!cpuGroupCumulativeCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupCumulativeCache = malloc(n_groups * sizeof(uint32_t)); + cpuGroupCumulativeCache = stgMallocBytes(n_groups * sizeof(uint32_t), "getProcessorsCumulativeSum"); memset(cpuGroupCumulativeCache, 0, n_groups * sizeof(uint32_t)); #if defined(x86_64_HOST_ARCH) @@ -306,7 +306,7 @@ createProcessorGroupMap (void) uint32_t numProcs = getNumberOfProcessors(); - cpuGroupCache = malloc(numProcs * sizeof(uint8_t)); + cpuGroupCache = stgMallocBytes(numProcs * sizeof(uint8_t), "createProcessorGroupMap"); /* For 32bit Windows and 64bit older than Windows 7, create a default mapping. */ memset(cpuGroupCache, 0, numProcs * sizeof(uint8_t)); @@ -386,7 +386,7 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M ASSERT(n_groups > 0); ASSERT(n_proc > 0); - mask = malloc(n_groups * sizeof(DWORD_PTR)); + mask = stgMallocBytes(n_groups * sizeof(DWORD_PTR), "setThreadAffinity"); memset(mask, 0, n_groups * sizeof(DWORD_PTR)); /* The mask for the individual groups are all 0 based @@ -422,14 +422,14 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M { r = SetThreadAffinityMask(hThread, mask[i]); if (r == 0) { - free(mask); + stgFree(mask); sysErrorBelch("SetThreadAffinity"); stg_exit(EXIT_FAILURE); } } } - free(mask); + stgFree(mask); } void ===================================== rts/win32/WorkQueue.c ===================================== @@ -41,12 +41,7 @@ newSemaphore(int initCount, int max) WorkQueue* NewWorkQueue() { - WorkQueue* wq = (WorkQueue*)malloc(sizeof(WorkQueue)); - - if (!wq) { - queue_error("NewWorkQueue", "malloc() failed"); - return wq; - } + WorkQueue* wq = (WorkQueue*)stgMallocBytes(sizeof(WorkQueue), "NewWorkQueue"); memset(wq, 0, sizeof *wq); ===================================== rts/xxhash.c ===================================== @@ -98,9 +98,9 @@ ***************************************/ /*! Modify the local functions below should you wish to use some other memory routines * for malloc(), free() */ -#include -static void* XXH_malloc(size_t s) { return malloc(s); } -static void XXH_free (void* p) { free(p); } +#include "RtsUtils.h" +static void* XXH_malloc(size_t s) { return stgMallocBytes(s, "XXH_malloc"); } +static void XXH_free (void* p) { stgFree(p); } /*! and for memcpy() */ #include static void* XXH_memcpy(void* dest, const void* src, size_t size) { return memcpy(dest,src,size); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eca239acfafb3735977a5daf510ee7663eddcffd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eca239acfafb3735977a5daf510ee7663eddcffd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 1 18:53:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 01 Sep 2020 14:53:51 -0400 Subject: [Git][ghc/ghc][wip/T18302] 531 commits: Add link to GHC's wiki in the GHC API header Message-ID: <5f4e98bf974b1_80b3f83d0b7b16c1021498a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18302 at Glasgow Haskell Compiler / GHC Commits: 9b607671 by Takenobu Tani at 2020-06-09T08:05:46-04:00 Add link to GHC's wiki in the GHC API header This adds a URL to point to GHC's wiki in the GHC API header. Newcomers could easily find more information from the GHC API's web like [1]. [1]: Current version, https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-8.11.0.20200604/index.html [skip ci] - - - - - 72c7fe9a by Ryan Scott at 2020-06-09T08:06:24-04:00 Make GADT constructors adhere to the forall-or-nothing rule properly Issue #18191 revealed that the types of GADT constructors don't quite adhere to the `forall`-or-nothing rule. This patch serves to clean up this sad state of affairs somewhat. The main change is not in the code itself, but in the documentation, as this patch introduces two sections to the GHC User's Guide: * A "Formal syntax for GADTs" section that presents a BNF-style grammar for what is and isn't allowed in GADT constructor types. This mostly exists to codify GHC's existing behavior, but it also imposes a new restriction that addresses #18191: the outermost `forall` and/or context in a GADT constructor is not allowed to be surrounded by parentheses. Doing so would make these `forall`s/contexts nested, and GADTs do not support nested `forall`s/contexts at present. * A "`forall`-or-nothing rule" section that describes exactly what the `forall`-or-nothing rule is all about. Surprisingly, there was no mention of this anywhere in the User's Guide up until now! To adhere the new specification in the "Formal syntax for GADTs" section of the User's Guide, the following code changes were made: * A new function, `GHC.Hs.Type.splitLHsGADTPrefixTy`, was introduced. This is very much like `splitLHsSigmaTy`, except that it avoids splitting apart any parentheses, which can be syntactically significant for GADT types. See `Note [No nested foralls or contexts in GADT constructors]` in `GHC.Hs.Type`. * `ConDeclGADTPrefixPs`, an extension constructor for `XConDecl`, was introduced so that `GHC.Parser.PostProcess.mkGadtDecl` can return it when given a prefix GADT constructor. Unlike `ConDeclGADT`, `ConDeclGADTPrefixPs` does not split the GADT type into its argument and result types, as this cannot be done until after the type is renamed (see `Note [GADT abstract syntax]` in `GHC.Hs.Decls` for why this is the case). * `GHC.Renamer.Module.rnConDecl` now has an additional case for `ConDeclGADTPrefixPs` that (1) splits apart the full `LHsType` into its `forall`s, context, argument types, and result type, and (2) checks for nested `forall`s/contexts. Step (2) used to be performed the typechecker (in `GHC.Tc.TyCl.badDataConTyCon`) rather than the renamer, but now the relevant code from the typechecker can simply be deleted. One nice side effect of this change is that we are able to give a more accurate error message for GADT constructors that use visible dependent quantification (e.g., `MkFoo :: forall a -> a -> Foo a`), which improves the stderr in the `T16326_Fail6` test case. Fixes #18191. Bumps the Haddock submodule. - - - - - a47e6442 by Ryan Scott at 2020-06-10T03:39:12-04:00 Always use rnImplicitBndrs to bring implicit tyvars into scope This implements a first step towards #16762 by changing the renamer to always use `rnImplicitBndrs` to bring implicitly bound type variables into scope. The main change is in `rnFamInstEqn` and `bindHsQTyVars`, which previously used _ad hoc_ methods of binding their implicit tyvars. There are a number of knock-on consequences: * One of the reasons that `rnFamInstEqn` used an _ad hoc_ binding mechanism was to give more precise source locations in `-Wunused-type-patterns` warnings. (See https://gitlab.haskell.org/ghc/ghc/issues/16762#note_273343 for an example of this.) However, these warnings are actually a little _too_ precise, since implicitly bound type variables don't have exact binding sites like explicitly bound type variables do. A similar problem existed for "`Different names for the same type variable`" errors involving implicit tyvars bound by `bindHsQTyVars`. Therefore, we simply accept the less precise (but more accurate) source locations from `rnImplicitBndrs` in `rnFamInstEqn` and `bindHsQTyVars`. See `Note [Source locations for implicitly bound type variables]` in `GHC.Rename.HsType` for the full story. * In order for `rnImplicitBndrs` to work in `rnFamInstEqn`, it needs to be able to look up names from the parent class (in the event that we are renaming an associated type family instance). As a result, `rnImplicitBndrs` now takes an argument of type `Maybe assoc`, which is `Just` in the event that a type family instance is associated with a class. * Previously, GHC kept track of three type synonyms for free type variables in the renamer: `FreeKiTyVars`, `FreeKiTyVarsDups` (which are allowed to contain duplicates), and `FreeKiTyVarsNoDups` (which contain no duplicates). However, making is a distinction between `-Dups` and `-NoDups` is now pointless, as all code that returns `FreeKiTyVars{,Dups,NoDups}` will eventually end up being passed to `rnImplicitBndrs`, which removes duplicates. As a result, I decided to just get rid of `FreeKiTyVarsDups` and `FreeKiTyVarsNoDups`, leaving only `FreeKiTyVars`. * The `bindLRdrNames` and `deleteBys` functions are now dead code, so I took the liberty of removing them. - - - - - 24879129 by Takenobu Tani at 2020-06-10T03:39:59-04:00 Clarify leaf module names for new module hierarchy This updates comments only. This patch replaces leaf module names according to new module hierarchy [1][2] as followings: * Expand leaf names to easily find the module path: for instance, `Id.hs` to `GHC.Types.Id`. * Modify leaf names according to new module hierarchy: for instance, `Convert.hs` to `GHC.ThToHs`. * Fix typo: for instance, `GHC.Core.TyCo.Rep.hs` to `GHC.Core.TyCo.Rep` See also !3375 [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 92de9e25 by Ömer Sinan Ağacan at 2020-06-10T03:41:07-04:00 rts: Remove unused GET_ENTRY closure macro This macro is not used and got broken in the meantime, as ENTRY_CODE was deleted. - - - - - 87102928 by Ömer Sinan Ağacan at 2020-06-10T03:41:50-04:00 Fix -fkeep-cafs flag name in users guide - - - - - ccd6843d by Shayne Fletcher at 2020-06-10T04:14:57-04:00 Expose impliedGFlags, impledOffGFlags, impliedXFlags - - - - - 7a737e89 by Ömer Sinan Ağacan at 2020-06-10T04:14:58-04:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules This is for optimization purposes: if we know LambdaFormInfo of imported Ids we can generate more efficient calling code, see `getCallMethod`. Exporting (putting them in interface files or in ModDetails) and importing (reading them from interface files) are both optional. We don't assume known LambdaFormInfos anywhere and do not change how we call Ids with unknown LambdaFormInfos. Runtime, allocation, and residency numbers when building Cabal-the-library (commit 0d4ee7ba3): (Log and .hp files are in the MR: !2842) | | GHC HEAD | This patch | Diff | |-----|----------|------------|----------------| | -O0 | 0:35.89 | 0:34.10 | -1.78s, -4.98% | | -O1 | 2:24.01 | 2:23.62 | -0.39s, -0.27% | | -O2 | 2:52.23 | 2:51.35 | -0.88s, -0.51% | | | GHC HEAD | This patch | Diff | |-----|-----------------|-----------------|----------------------------| | -O0 | 54,843,608,416 | 54,878,769,544 | +35,161,128 bytes, +0.06% | | -O1 | 227,136,076,400 | 227,569,045,168 | +432,968,768 bytes, +0.19% | | -O2 | 266,147,063,296 | 266,749,643,440 | +602,580,144 bytes, +0.22% | NOTE: Residency is measured with extra runtime args: `-i0 -h` which effectively turn all GCs into major GCs, and do GC more often. | | GHC HEAD | This patch | Diff | |-----|----------------------------|------------------------------|----------------------------| | -O0 | 410,284,000 (910 samples) | 411,745,008 (906 samples) | +1,461,008 bytes, +0.35% | | -O1 | 928,580,856 (2109 samples) | 943,506,552 (2103 samples) | +14,925,696 bytes, +1.60% | | -O2 | 993,951,352 (2549 samples) | 1,010,156,328 (2545 samples) | +16,204,9760 bytes, +1.63% | NoFib results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS 0.0% 0.0% +0.0% +0.0% +0.0% CSD 0.0% 0.0% 0.0% +0.0% +0.0% FS 0.0% 0.0% +0.0% +0.0% +0.0% S 0.0% 0.0% +0.0% +0.0% +0.0% VS 0.0% 0.0% +0.0% +0.0% +0.0% VSD 0.0% 0.0% +0.0% +0.0% +0.1% VSM 0.0% 0.0% +0.0% +0.0% +0.0% anna 0.0% 0.0% -0.3% -0.8% -0.0% ansi 0.0% 0.0% -0.0% -0.0% 0.0% atom 0.0% 0.0% -0.0% -0.0% 0.0% awards 0.0% 0.0% -0.1% -0.3% 0.0% banner 0.0% 0.0% -0.0% -0.0% -0.0% bernouilli 0.0% 0.0% -0.0% -0.0% -0.0% binary-trees 0.0% 0.0% -0.0% -0.0% +0.0% boyer 0.0% 0.0% -0.0% -0.0% 0.0% boyer2 0.0% 0.0% -0.0% -0.0% 0.0% bspt 0.0% 0.0% -0.0% -0.2% 0.0% cacheprof 0.0% 0.0% -0.1% -0.4% +0.0% calendar 0.0% 0.0% -0.0% -0.0% 0.0% cichelli 0.0% 0.0% -0.9% -2.4% 0.0% circsim 0.0% 0.0% -0.0% -0.0% 0.0% clausify 0.0% 0.0% -0.1% -0.3% 0.0% comp_lab_zift 0.0% 0.0% -0.0% -0.0% +0.0% compress 0.0% 0.0% -0.0% -0.0% -0.0% compress2 0.0% 0.0% -0.0% -0.0% 0.0% constraints 0.0% 0.0% -0.1% -0.2% -0.0% cryptarithm1 0.0% 0.0% -0.0% -0.0% 0.0% cryptarithm2 0.0% 0.0% -1.4% -4.1% -0.0% cse 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 0.0% 0.0% -0.0% -0.0% -0.0% dom-lt 0.0% 0.0% -0.1% -0.2% 0.0% eliza 0.0% 0.0% -0.5% -1.5% 0.0% event 0.0% 0.0% -0.0% -0.0% -0.0% exact-reals 0.0% 0.0% -0.1% -0.3% +0.0% exp3_8 0.0% 0.0% -0.0% -0.0% -0.0% expert 0.0% 0.0% -0.3% -1.0% -0.0% fannkuch-redux 0.0% 0.0% +0.0% +0.0% +0.0% fasta 0.0% 0.0% -0.0% -0.0% +0.0% fem 0.0% 0.0% -0.0% -0.0% 0.0% fft 0.0% 0.0% -0.0% -0.0% 0.0% fft2 0.0% 0.0% -0.0% -0.0% 0.0% fibheaps 0.0% 0.0% -0.0% -0.0% +0.0% fish 0.0% 0.0% 0.0% -0.0% +0.0% fluid 0.0% 0.0% -0.4% -1.2% +0.0% fulsom 0.0% 0.0% -0.0% -0.0% 0.0% gamteb 0.0% 0.0% -0.1% -0.3% 0.0% gcd 0.0% 0.0% -0.0% -0.0% 0.0% gen_regexps 0.0% 0.0% -0.0% -0.0% -0.0% genfft 0.0% 0.0% -0.0% -0.0% 0.0% gg 0.0% 0.0% -0.0% -0.0% +0.0% grep 0.0% 0.0% -0.0% -0.0% -0.0% hidden 0.0% 0.0% -0.1% -0.4% -0.0% hpg 0.0% 0.0% -0.2% -0.5% +0.0% ida 0.0% 0.0% -0.0% -0.0% +0.0% infer 0.0% 0.0% -0.3% -0.8% -0.0% integer 0.0% 0.0% -0.0% -0.0% +0.0% integrate 0.0% 0.0% -0.0% -0.0% 0.0% k-nucleotide 0.0% 0.0% -0.0% -0.0% +0.0% kahan 0.0% 0.0% -0.0% -0.0% +0.0% knights 0.0% 0.0% -2.2% -5.4% 0.0% lambda 0.0% 0.0% -0.6% -1.8% 0.0% last-piece 0.0% 0.0% -0.0% -0.0% 0.0% lcss 0.0% 0.0% -0.0% -0.1% 0.0% life 0.0% 0.0% -0.0% -0.1% 0.0% lift 0.0% 0.0% -0.2% -0.6% +0.0% linear 0.0% 0.0% -0.0% -0.0% -0.0% listcompr 0.0% 0.0% -0.0% -0.0% 0.0% listcopy 0.0% 0.0% -0.0% -0.0% 0.0% maillist 0.0% 0.0% -0.1% -0.3% +0.0% mandel 0.0% 0.0% -0.0% -0.0% 0.0% mandel2 0.0% 0.0% -0.0% -0.0% -0.0% mate +0.0% 0.0% -0.0% -0.0% -0.0% minimax 0.0% 0.0% -0.2% -1.0% 0.0% mkhprog 0.0% 0.0% -0.1% -0.2% -0.0% multiplier 0.0% 0.0% -0.0% -0.0% -0.0% n-body 0.0% 0.0% -0.0% -0.0% +0.0% nucleic2 0.0% 0.0% -0.1% -0.2% 0.0% para 0.0% 0.0% -0.0% -0.0% -0.0% paraffins 0.0% 0.0% -0.0% -0.0% 0.0% parser 0.0% 0.0% -0.2% -0.7% 0.0% parstof 0.0% 0.0% -0.0% -0.0% +0.0% pic 0.0% 0.0% -0.0% -0.0% 0.0% pidigits 0.0% 0.0% +0.0% +0.0% +0.0% power 0.0% 0.0% -0.2% -0.6% +0.0% pretty 0.0% 0.0% -0.0% -0.0% -0.0% primes 0.0% 0.0% -0.0% -0.0% 0.0% primetest 0.0% 0.0% -0.0% -0.0% -0.0% prolog 0.0% 0.0% -0.3% -1.1% 0.0% puzzle 0.0% 0.0% -0.0% -0.0% 0.0% queens 0.0% 0.0% -0.0% -0.0% +0.0% reptile 0.0% 0.0% -0.0% -0.0% 0.0% reverse-complem 0.0% 0.0% -0.0% -0.0% +0.0% rewrite 0.0% 0.0% -0.7% -2.5% -0.0% rfib 0.0% 0.0% -0.0% -0.0% 0.0% rsa 0.0% 0.0% -0.0% -0.0% 0.0% scc 0.0% 0.0% -0.1% -0.2% -0.0% sched 0.0% 0.0% -0.0% -0.0% -0.0% scs 0.0% 0.0% -1.0% -2.6% +0.0% simple 0.0% 0.0% +0.0% -0.0% +0.0% solid 0.0% 0.0% -0.0% -0.0% 0.0% sorting 0.0% 0.0% -0.6% -1.6% 0.0% spectral-norm 0.0% 0.0% +0.0% 0.0% +0.0% sphere 0.0% 0.0% -0.0% -0.0% -0.0% symalg 0.0% 0.0% -0.0% -0.0% +0.0% tak 0.0% 0.0% -0.0% -0.0% 0.0% transform 0.0% 0.0% -0.0% -0.0% 0.0% treejoin 0.0% 0.0% -0.0% -0.0% 0.0% typecheck 0.0% 0.0% -0.0% -0.0% +0.0% veritas +0.0% 0.0% -0.2% -0.4% +0.0% wang 0.0% 0.0% -0.0% -0.0% 0.0% wave4main 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 0.0% 0.0% -0.0% -0.0% +0.0% x2n1 0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min 0.0% 0.0% -2.2% -5.4% -0.0% Max +0.0% 0.0% +0.0% +0.0% +0.1% Geometric Mean -0.0% -0.0% -0.1% -0.3% +0.0% Metric increases micro benchmarks tracked in #17686: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 T9233 Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 3b22b14a by Shayne Fletcher at 2020-06-10T04:15:01-04:00 Give Language a Bounded instance - - - - - 9454511b by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Optimisation in Unique.Supply This patch switches on -fno-state-hack in GHC.Types.Unique.Supply. It turned out that my fixes for #18078 (coercion floating) changed the optimisation pathway for mkSplitUniqSupply in such a way that we had an extra allocation inside the inner loop. Adding -fno-state-hack fixed that -- and indeed the loop in mkSplitUniqSupply is a classic example of the way in which -fno-state-hack can be bad; see #18238. Moreover, the new code is better than the old. They allocate the same, but the old code ends up with a partial application. The net effect is that the test perf/should_run/UniqLoop runs 20% faster! From 2.5s down to 2.0s. The allocation numbers are the same -- but elapsed time falls. Good! The bad thing about this is that it's terribly delicate. But at least it's a good example of such delicacy in action. There is a long Note [Optimising the unique supply] which now explains all this. - - - - - 6d49d5be by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Implement cast worker/wrapper properly The cast worker/wrapper transformation transforms x = e |> co into y = e x = y |> co This is done by the simplifier, but we were being careless about transferring IdInfo from x to y, and about what to do if x is a NOINLNE function. This resulted in a series of bugs: #17673, #18093, #18078. This patch fixes all that: * Main change is in GHC.Core.Opt.Simplify, and the new prepareBinding function, which does this cast worker/wrapper transform. See Note [Cast worker/wrappers]. * There is quite a bit of refactoring around prepareRhs, makeTrivial etc. It's nicer now. * Some wrappers from strictness and cast w/w, notably those for a function with a NOINLINE, should inline very late. There wasn't really a mechanism for that, which was an existing bug really; so I invented a new finalPhase = Phase (-1). It's used for all simplifier runs after the user-visible phase 2,1,0 have run. (No new runs of the simplifier are introduced thereby.) See new Note [Compiler phases] in GHC.Types.Basic; the main changes are in GHC.Core.Opt.Driver * Doing this made me trip over two places where the AnonArgFlag on a FunTy was being lost so we could end up with (Num a -> ty) rather than (Num a => ty) - In coercionLKind/coercionRKind - In contHoleType in the Simplifier I fixed the former by defining mkFunctionType and using it in coercionLKind/RKind. I could have done the same for the latter, but the information is almost to hand. So I fixed the latter by - adding sc_hole_ty to ApplyToVal (like ApplyToTy), - adding as_hole_ty to ValArg (like TyArg) - adding sc_fun_ty to StrictArg Turned out I could then remove ai_type from ArgInfo. This is just moving the deck chairs around, but it worked out nicely. See the new Note [AnonArgFlag] in GHC.Types.Var * When looking at the 'arity decrease' thing (#18093) I discovered that stable unfoldings had a much lower arity than the actual optimised function. That's what led to the arity-decrease message. Simple solution: eta-expand. It's described in Note [Eta-expand stable unfoldings] in GHC.Core.Opt.Simplify * I also discovered that unsafeCoerce wasn't being inlined if the context was boring. So (\x. f (unsafeCoerce x)) would create a thunk -- yikes! I fixed that by making inlineBoringOK a bit cleverer: see Note [Inline unsafeCoerce] in GHC.Core.Unfold. I also found that unsafeCoerceName was unused, so I removed it. I made a test case for #18078, and a very similar one for #17673. The net effect of all this on nofib is very modest, but positive: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna -0.4% -0.1% -3.1% -3.1% 0.0% fannkuch-redux -0.4% -0.3% -0.1% -0.1% 0.0% maillist -0.4% -0.1% -7.8% -1.0% -14.3% primetest -0.4% -15.6% -7.1% -6.6% 0.0% -------------------------------------------------------------------------------- Min -0.9% -15.6% -13.3% -14.2% -14.3% Max -0.3% 0.0% +12.1% +12.4% 0.0% Geometric Mean -0.4% -0.2% -2.3% -2.2% -0.1% All following metric decreases are compile-time allocation decreases between -1% and -3%: Metric Decrease: T5631 T13701 T14697 T15164 - - - - - 32fd37f5 by Luke Lau at 2020-06-10T04:17:22-04:00 Fix lookupGlobalOccRn_maybe sometimes reporting an error In some cases it was possible for lookupGlobalOccRn_maybe to return an error, when it should be returning a Nothing. If it called lookupExactOcc_either when there were no matching GlobalRdrElts in the otherwise case, it would return an error message. This could be caused when lookupThName_maybe in Template Haskell was looking in different namespaces (thRdrNameGuesses), guessing different namespaces that the name wasn't guaranteed to be found in. However, by addressing this some more accurate errors were being lost in the conversion to Maybes. So some of the lookup* functions have been shuffled about so that errors should always be ignored in lookup*_maybes, and propagated otherwise. This fixes #18263 - - - - - 9b283e1b by Roland Senn at 2020-06-10T04:17:34-04:00 Initialize the allocation counter in GHCi to 0 (Fixes #16012) According to the documentation for the function `getAllocationCounter` in [System.Mem](http://hackage.haskell.org/package/base-4.14.0.0/docs/System-Mem.html) initialize the allocationCounter also in GHCi to 0. - - - - - 8d07c48c by Sylvain Henry at 2020-06-10T04:17:36-04:00 test: fix conc038 We had spurious failures of conc038 test on CI with stdout: ``` newThread started -mainThread -Haskell: 2 newThread back again +mainThread 1 sec later shutting down +Haskell: 2 ``` - - - - - 4c7e9689 by Sebastian Graf at 2020-06-11T10:37:38+02:00 Release Notes: Add news from the pattern-match checker [skip ci] - - - - - 3445b965 by Sylvain Henry at 2020-06-13T02:13:01-04:00 Only test T16190 with the NCG T16190 is meant to test a NCG feature. It has already caused spurious failures in other MRs (e.g. !2165) when LLVM is used. - - - - - 2517a51c by Sylvain Henry at 2020-06-13T02:13:01-04:00 DynFlags refactoring VIII (#17957) * Remove several uses of `sdocWithDynFlags`, especially in GHC.Llvm.* * Add LlvmOpts datatype to store Llvm backend options * Remove Outputable instances (for LlvmVar, LlvmLit, LlvmStatic and Llvm.MetaExpr) which require LlvmOpts. * Rename ppMetaExpr into ppMetaAnnotExpr (pprMetaExpr is now used in place of `ppr :: MetaExpr -> SDoc`) - - - - - 7a02599a by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove unused code - - - - - 72d08610 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor homeUnit * rename thisPackage into homeUnit * document and refactor several Backpack things - - - - - 8dc71f55 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Rename unsafeGetUnitInfo into unsafeLookupUnit - - - - - f6be6e43 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Add allowVirtualUnits field in PackageState Instead of always querying DynFlags to know whether we are allowed to use virtual units (i.e. instantiated on-the-fly, cf Note [About units] in GHC.Unit), we store it once for all in `PackageState.allowVirtualUnits`. This avoids using DynFlags too much (cf #17957) and is preliminary work for #14335. - - - - - e7272d53 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Enhance UnitId use * use UnitId instead of String to identify wired-in units * use UnitId instead of Unit in the backend (Unit are only use by Backpack to produce type-checked interfaces, not real code) * rename lookup functions for consistency * documentation - - - - - 9c5572cd by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove LinkerUnitId type alias - - - - - d345edfe by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor WiredMap * Remove WiredInUnitId and WiredUnitId type aliases - - - - - 3d171cd6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document and refactor `mkUnit` and `mkUnitInfoMap` - - - - - d2109b4f by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove PreloadUnitId type alias - - - - - f50c19b8 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename listUnitInfoMap into listUnitInfo There is no Map involved - - - - - ed533ec2 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit The terminology changed over time and now package databases contain "units" (there can be several units compiled from a single Cabal package: one per-component, one for each option set, one per instantiation, etc.). We should try to be consistent internally and use "units": that's what this renaming does. Maybe one day we'll fix the UI too (e.g. replace -package-id with -unit-id, we already have -this-unit-id and ghc-pkg has -unit-id...) but it's not done in this patch. * rename getPkgFrameworkOpts into getUnitFrameworkOpts * rename UnitInfoMap into ClosureUnitInfoMap * rename InstalledPackageIndex into UnitInfoMap * rename UnusablePackages into UnusableUnits * rename PackagePrecedenceIndex into UnitPrecedenceMap * rename PackageDatabase into UnitDatabase * rename pkgDatabase into unitDatabases * rename pkgState into unitState * rename initPackages into initUnits * rename renamePackage into renameUnitInfo * rename UnusablePackageReason into UnusableUnitReason * rename getPackage* into getUnit* * etc. - - - - - 202728e5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Make ClosureUnitInfoMap uses UnitInfoMap - - - - - 55b4263e by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove ClosureUnitInfoMap - - - - - 653d17bd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit (2) * rename PackageState into UnitState * rename findWiredInPackages into findWiredInUnits * rename lookupModuleInAll[Packages,Units] * etc. - - - - - ae900605 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move dump_mod_map into initUnits - - - - - 598cc1dd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move wiring of homeUnitInstantiations outside of mkUnitState - - - - - 437265eb by Sylvain Henry at 2020-06-13T02:13:03-04:00 Avoid timing module map dump in initUnits - - - - - 9400aa93 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove preload parameter of mkUnitState * Remove preload parameter (unused) * Don't explicitly return preloaded units: redundant because already returned as "preloadUnits" field of UnitState - - - - - 266bc3d9 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: refactor unwireUnit - - - - - 9e715c1b by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document getPreloadUnitsAnd - - - - - bd5810dc by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: remove useless add_package parameter - - - - - 36e1daf0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: make listVisibleModuleNames take a UnitState - - - - - 5226da37 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document add_package - - - - - 4b53aac1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document closeUnitDeps - - - - - 42c054f6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: findWiredInUnits - - - - - a444d01b by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: reportCycles, reportUnusable - - - - - 8408d521 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: merge_databases - - - - - fca2d25f by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: add UnitConfig datatype Avoid directly querying flags from DynFlags to build the UnitState. Instead go via UnitConfig so that we could reuse this to make another UnitState for plugins. - - - - - 4274688a by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move distrustAll into mkUnitState - - - - - 28d804e1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Create helper upd_wired_in_home_instantiations - - - - - ac964c83 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Put database cache in UnitConfig - - - - - bfd0a78c by Sylvain Henry at 2020-06-13T02:13:03-04:00 Don't return preload units when we set DyNFlags Preload units can be retrieved in UnitState when needed (i.e. in GHCi) - - - - - 1fbb4bf5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 NCGConfig: remove useless ncgUnitId field - - - - - c10ff7e7 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Doc: fix some comments - - - - - 456e17f0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Bump haddock submodule and allow metric decrease Metric Decrease: T12150 T12234 T5837 Metric Increase: T16190 - - - - - 42953902 by Simon Peyton Jones at 2020-06-13T02:13:03-04:00 Trim the demand for recursive product types Ticket #18304 showed that we need to be very careful when exploring the demand (esp usage demand) on recursive product types. This patch solves the problem by trimming the demand on such types -- in effect, a form of "widening". See the Note [Trimming a demand to a type] in DmdAnal, which explains how I did this by piggy-backing on an existing mechansim for trimming demands becuase of GADTs. The significant payload of this patch is very small indeed: * Make GHC.Core.Opt.WorkWrap.Utils.typeShape use RecTcChecker to avoid looking through recursive types. But on the way * I found that ae_rec_tc was entirely inoperative and did nothing. So I removed it altogether from DmdAnal. * I moved some code around in DmdAnal and Demand. (There are no actual changes in dmdFix.) * I changed the API of DmsAnal.dmdAnalRhsLetDown to return a StrictSig rather than a decorated Id * I removed the dead function peelTsFuns from Demand Performance effects: Nofib: 0.0% changes. Not surprising, because they don't use recursive products Perf tests T12227: 1% increase in compiler allocation, becuase $cto gets w/w'd. It did not w/w before because it takes a deeply nested argument, so the worker gets too many args, so we abandon w/w altogether (see GHC.Core.Opt.WorkWrap.Utils.isWorkerSmallEnough) With this patch we trim the demands. That is not strictly necessary (since these Generic type constructors are like tuples -- they can't cause a loop) but the net result is that we now w/w $cto which is fine. UniqLoop: 16% decrease in /runtime/ allocation. The UniqSupply is a recursive product, so currently we abandon all strictness on 'churn'. With this patch 'churn' gets useful strictness, and we w/w it. Hooray Metric Decrease: UniqLoop Metric Increase: T12227 - - - - - 87d504f4 by Viktor Dukhovni at 2020-06-13T02:13:05-04:00 Add introductory prose for Data.Traversable - - - - - 9f09b608 by Oleg Grenrus at 2020-06-13T02:13:07-04:00 Fix #12073: Add MonadFix Q instance - - - - - 220c2d34 by Ben Gamari at 2020-06-13T02:13:07-04:00 testsuite: Increase size of T12150 As noted in #18319, this test was previously very fragile. Increase its size to make it more likely that its fails with its newly-increased acceptance threshold. Metric Increase: T12150 - - - - - 8bba1c26 by Ben Gamari at 2020-06-13T04:59:06-04:00 gitlab-ci: Always push perf notes Previously we ci.sh would run with `set -e` implying that we wouldn't push perf notes if the testsuite were to fail, even if it *only* failed due to perf notes. This rendered the whole performance testing story quite fragile as a single regressing commit would cause every successive commit to fail since a new baseline would not be uploaded. Fix this by ensuring that we always push performance notes. - - - - - 7a773f16 by Ben Gamari at 2020-06-13T15:10:55-04:00 gitlab-ci: Eliminate redundant push of CI metrics - - - - - a31218f7 by Ryan Scott at 2020-06-13T15:58:37-04:00 Use HsForAllTelescope to avoid inferred, visible foralls Currently, `HsForAllTy` permits the combination of `ForallVis` and `Inferred`, but you can't actually typecheck code that uses it (e.g., `forall {a} ->`). This patch refactors `HsForAllTy` to use a new `HsForAllTelescope` data type that makes a type-level distinction between visible and invisible `forall`s such that visible `forall`s do not track `Specificity`. That part of the patch is actually quite small; the rest is simply changing consumers of `HsType` to accommodate this new type. Fixes #18235. Bumps the `haddock` submodule. - - - - - c0e6dee9 by Tamar Christina at 2020-06-14T09:07:44-04:00 winio: Add Atomic Exchange PrimOp and implement Atomic Ptr exchanges. The initial version was rewritten by Tamar Christina. It was rewritten in large parts by Andreas Klebinger. Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 9a7462fb by Ben Gamari at 2020-06-14T15:35:23-04:00 codeGen: Don't discard live case binders in unsafeEqualityProof logic Previously CoreToStg would unconditionally discard cases of the form: case unsafeEqualityProof of wild { _ -> rhs } and rather replace the whole thing with `rhs`. However, in some cases (see #18227) the case binder is still live, resulting in unbound occurrences in `rhs`. Fix this by only discarding the case if the case binder is dead. Fixes #18227. - - - - - e4137c48 by Ben Gamari at 2020-06-14T15:35:23-04:00 testsuite: Add tests for #18227 T18227A is the original issue which gave rise to the ticket and depends upon bytestring. T18227B is a minimized reproducer. - - - - - 8bab9ff1 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Fix rts include and library paths Fixes two bugs: * (?) and (<>) associated in a surprising way * We neglected to include libdw paths in the rts configure flags - - - - - bd761185 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Drop redundant GHC arguments Cabal should already be passing this arguments to GHC. - - - - - 01f7052c by Peter Trommler at 2020-06-14T15:36:38-04:00 FFI: Fix pass small ints in foreign call wrappers The Haskell calling convention requires integer parameters smaller than wordsize to be promoted to wordsize (where the upper bits are don't care). To access such small integer parameter read a word from the parameter array and then cast that word to the small integer target type. Fixes #15933 - - - - - 502647f7 by Krzysztof Gogolewski at 2020-06-14T15:37:14-04:00 Fix "ndecreasingIndentation" in manual (#18116) - - - - - 9a9cc089 by Simon Jakobi at 2020-06-15T13:10:00-04:00 Use foldl' in unionManyUniqDSets - - - - - 761dcb84 by Moritz Angermann at 2020-06-15T13:10:36-04:00 Load .lo as well. Some archives contain so called linker objects, with the affectionate .lo suffic. For example the musl libc.a will come in that form. We still want to load those objects, hence we should not discard them and look for .lo as well. Ultimately we might want to fix this proerly by looking at the file magic. - - - - - cf01477f by Vladislav Zavialov at 2020-06-15T13:11:20-04:00 User's Guide: KnownNat evidence is Natural This bit of documentation got outdated after commit 1fcede43d2b30f33b7505e25eb6b1f321be0407f - - - - - d0dcbfe6 by Jan Hrček at 2020-06-16T20:36:38+02:00 Fix typos and formatting in user guide - - - - - 56a9e95f by Jan Hrček at 2020-06-16T20:36:38+02:00 Resolve TODO - - - - - 3e884d14 by Jan Hrček at 2020-06-16T20:36:38+02:00 Rename TcHoleErrors to GHC.Tc.Errors.Hole - - - - - d23fc678 by Stefan Schulze Frielinghaus at 2020-06-17T15:31:09-04:00 hadrian: Build with threaded runtime if available See #16873. - - - - - 0639dc10 by Sylvain Henry at 2020-06-17T15:31:53-04:00 T16190: only measure bytes_allocated Just adding `{-# LANGUAGE BangPatterns #-}` makes the two other metrics fluctuate by 13%. - - - - - 4cab6897 by Adam Sandberg Ericsson at 2020-06-17T15:32:44-04:00 docs: fix formatting in users guide - - - - - eb8115a8 by Sylvain Henry at 2020-06-17T15:33:23-04:00 Move CLabel assertions into smart constructors (#17957) It avoids using DynFlags in the Outputable instance of Clabel to check assertions at pretty-printing time. - - - - - 7faa4509 by Ben Gamari at 2020-06-17T15:43:31-04:00 base: Bump to 4.15.0.0 - - - - - 20616959 by Ben Gamari at 2020-06-17T15:43:31-04:00 configure: Use grep -q instead of --quiet The latter is apparently not supported by busybox. - - - - - 40fa237e by Krzysztof Gogolewski at 2020-06-17T16:21:58-04:00 Linear types (#15981) This is the first step towards implementation of the linear types proposal (https://github.com/ghc-proposals/ghc-proposals/pull/111). It features * A language extension -XLinearTypes * Syntax for linear functions in the surface language * Linearity checking in Core Lint, enabled with -dlinear-core-lint * Core-to-core passes are mostly compatible with linearity * Fields in a data type can be linear or unrestricted; linear fields have multiplicity-polymorphic constructors. If -XLinearTypes is disabled, the GADT syntax defaults to linear fields The following items are not yet supported: * a # m -> b syntax (only prefix FUN is supported for now) * Full multiplicity inference (multiplicities are really only checked) * Decent linearity error messages * Linear let, where, and case expressions in the surface language (each of these currently introduce the unrestricted variant) * Multiplicity-parametric fields * Syntax for annotating lambda-bound or let-bound with a multiplicity * Syntax for non-linear/multiple-field-multiplicity records * Linear projections for records with a single linear field * Linear pattern synonyms * Multiplicity coercions (test LinearPolyType) A high-level description can be found at https://ghc.haskell.org/trac/ghc/wiki/LinearTypes/Implementation Following the link above you will find a description of the changes made to Core. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Matthew Pickering * Arnaud Spiwack With contributions from: * Mark Barbone * Alexander Vershilov Updates haddock submodule. - - - - - 6cb84c46 by Krzysztof Gogolewski at 2020-06-17T16:22:03-04:00 Various performance improvements This implements several general performance improvements to GHC, to offset the effect of the linear types change. General optimisations: - Add a `coreFullView` function which iterates `coreView` on the head. This avoids making function recursive solely because the iterate `coreView` themselves. As a consequence, this functions can be inlined, and trigger case-of-known constructor (_e.g._ `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`, `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`, `tyConAppTyCon_maybe`). The common pattern about all these functions is that they are almost always used as views, and immediately consumed by a case expression. This commit also mark them asx `INLINE`. - In `subst_ty` add a special case for nullary `TyConApp`, which avoid allocations altogether. - Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This required quite a bit of module shuffling. case. `myTyConApp` enforces crucial sharing, which was lost during substitution. See also !2952 . - Make `subst_ty` stricter. - In `eqType` (specifically, in `nonDetCmpType`), add a special case, tested first, for the very common case of nullary `TyConApp`. `nonDetCmpType` has been made `INLINE` otherwise it is actually a regression. This is similar to the optimisations in !2952. Linear-type specific optimisations: - Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in the definition of the pattern synonyms `One` and `Many`. - Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`: `Multiplicity` now import `Type` normally, rather than from the `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the `One` and `Many` pattern synonyms. - Make `updateIdTypeAndMult` strict in its type and multiplicity - The `scaleIdBy` gets a specialised definition rather than being an alias to `scaleVarBy` - `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type, Type)` instead of `Type -> Maybe (Scaled Type, Type)` - Remove the `MultMul` pattern synonym in favour of a view `isMultMul` because pattern synonyms appear not to inline well. - in `eqType`, in a `FunTy`, compare multiplicities last: they are almost always both `Many`, so it helps failing faster. - Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the instances of `TyConApp ManyDataConTy []` are physically the same. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Arnaud Spiwack Metric Decrease: haddock.base T12227 T12545 T12990 T1969 T3064 T5030 T9872b Metric Increase: haddock.base haddock.Cabal haddock.compiler T12150 T12234 T12425 T12707 T13035 T13056 T15164 T16190 T18304 T1969 T3064 T3294 T5631 T5642 T5837 T6048 T9020 T9233 T9675 T9872a T9961 WWRec - - - - - 57db91d8 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Remove integer-simple integer-simple uses lists of words (`[Word]`) to represent big numbers instead of ByteArray#: * it is less efficient than the newer ghc-bignum native backend * it isn't compatible with the big number representation that is now shared by all the ghc-bignum backends (based on the one that was used only in integer-gmp before). As a consequence, we simply drop integer-simple - - - - - 9f96bc12 by Sylvain Henry at 2020-06-17T16:22:03-04:00 ghc-bignum library ghc-bignum is a newer package that aims to replace the legacy integer-simple and integer-gmp packages. * it supports several backends. In particular GMP is still supported and most of the code from integer-gmp has been merged in the "gmp" backend. * the pure Haskell "native" backend is new and is much faster than the previous pure Haskell implementation provided by integer-simple * new backends are easier to write because they only have to provide a few well defined functions. All the other code is common to all backends. In particular they all share the efficient small/big number distinction previously used only in integer-gmp. * backends can all be tested against the "native" backend with a simple Cabal flag. Backends are only allowed to differ in performance, their results should be the same. * Add `integer-gmp` compat package: provide some pattern synonyms and function aliases for those in `ghc-bignum`. It is intended to avoid breaking packages that depend on `integer-gmp` internals. Update submodules: text, bytestring Metric Decrease: Conversions ManyAlternatives ManyConstructors Naperian T10359 T10547 T10678 T12150 T12227 T12234 T12425 T13035 T13719 T14936 T1969 T4801 T4830 T5237 T5549 T5837 T8766 T9020 parsing001 space_leak_001 T16190 haddock.base On ARM and i386, T17499 regresses (+6% > 5%). On x86_64 unregistered, T13701 sometimes regresses (+2.2% > 2%). Metric Increase: T17499 T13701 - - - - - 96aa5787 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update compiler Thanks to ghc-bignum, the compiler can be simplified: * Types and constructors of Integer and Natural can be wired-in. It means that we don't have to query them from interfaces. It also means that numeric literals don't have to carry their type with them. * The same code is used whatever ghc-bignum backend is enabled. In particular, conversion of bignum literals into final Core expressions is now much more straightforward. Bignum closure inspection too. * GHC itself doesn't depend on any integer-* package anymore * The `integerLibrary` setting is gone. - - - - - 0f67e344 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `base` package * GHC.Natural isn't implemented in `base` anymore. It is provided by ghc-bignum in GHC.Num.Natural. It means that we can safely use Natural primitives in `base` without fearing issues with built-in rewrite rules (cf #15286) * `base` doesn't conditionally depend on an integer-* package anymore, it depends on ghc-bignum * Some duplicated code in integer-* can now be factored in GHC.Float * ghc-bignum tries to use a uniform naming convention so most of the other changes are renaming - - - - - aa9e7b71 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `make` based build system * replace integer-* package selection with ghc-bignum backend selection - - - - - f817d816 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update testsuite * support detection of slow ghc-bignum backend (to replace the detection of integer-simple use). There are still some test cases that the native backend doesn't handle efficiently enough. * remove tests for GMP only functions that have been removed from ghc-bignum * fix test results showing dependent packages (e.g. integer-gmp) or showing suggested instances * fix test using Integer/Natural API or showing internal names - - - - - dceecb09 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update Hadrian * support ghc-bignum backend selection in flavours and command-line * support ghc-bignum "--check" flag (compare results of selected backend against results of the native one) in flavours and command-line (e.g. pass --bignum=check-gmp" to check the "gmp" backend) * remove the hack to workaround #15286 * build GMP only when the gmp backend is used * remove hacks to workaround `text` package flags about integer-*. We fix `text` to use ghc-bignum unconditionally in another patch - - - - - fa4281d6 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Bump bytestring and text submodules - - - - - 1a3f6f34 by Adam Sandberg Ericsson at 2020-06-18T23:03:36-04:00 docs: mention -hiedir in docs for -outputdir [skip ci] - - - - - 729bcb02 by Sylvain Henry at 2020-06-18T23:04:17-04:00 Hadrian: fix build on Mac OS Catalina (#17798) - - - - - 95e18292 by Andreas Klebinger at 2020-06-18T23:04:58-04:00 Relax allocation threshold for T12150. This test performs little work, so the most minor allocation changes often cause the test to fail. Increasing the threshold to 2% should help with this. - - - - - 8ce6c393 by Sebastian Graf at 2020-06-18T23:05:36-04:00 hadrian: Bump pinned cabal.project to an existent index-state - - - - - 08c1cb0f by Ömer Sinan Ağacan at 2020-06-18T23:06:21-04:00 Fix uninitialized field read in Linker.c Valgrind report of the bug when running the test `linker_unload`: ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x36C027A: loadArchive_ (LoadArchive.c:522) ==29666== by 0x36C0600: loadArchive (LoadArchive.c:626) ==29666== by 0x2C144CD: ??? (in /home/omer/haskell/ghc_2/testsuite/tests/rts/linker/linker_unload.run/linker_unload) ==29666== ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x369C9F6: preloadObjectFile (Linker.c:1507) ==29666== by 0x369CA8D: loadObj_ (Linker.c:1536) ==29666== by 0x369CB17: loadObj (Linker.c:1557) ==29666== by 0x3866BC: main (linker_unload.c:33) The problem is `mkOc` allocates a new `ObjectCode` and calls `setOcInitialStatus` without initializing the `status` field. `setOcInitialStatus` reads the field as first thing: static void setOcInitialStatus(ObjectCode* oc) { if (oc->status == OBJECT_DONT_RESOLVE) return; if (oc->archiveMemberName == NULL) { oc->status = OBJECT_NEEDED; } else { oc->status = OBJECT_LOADED; } } `setOcInitialStatus` is unsed in two places for two different purposes: in `mkOc` where we don't have the `status` field initialized yet (`mkOc` is supposed to initialize it), and `loadOc` where we do have `status` field initialized and we want to update it. Instead of splitting the function into two functions which are both called just once I inline the functions in the use sites and remove it. Fixes #18342 - - - - - da18ff99 by Tamar Christina at 2020-06-18T23:07:03-04:00 fix windows bootstrap due to linker changes - - - - - 2af0ec90 by Sylvain Henry at 2020-06-18T23:07:47-04:00 DynFlags: store default depth in SDocContext (#17957) It avoids having to use DynFlags to reach for pprUserLength. - - - - - d4a0be75 by Sylvain Henry at 2020-06-18T23:08:35-04:00 Move tablesNextToCode field into Platform tablesNextToCode is a platform setting and doesn't belong into DynFlags (#17957). Doing this is also a prerequisite to fix #14335 where we deal with two platforms (target and host) that may have different platform settings. - - - - - 809caedf by John Ericson at 2020-06-23T22:47:37-04:00 Switch from HscSource to IsBootInterface for module lookup in GhcMake We look up modules by their name, and not their contents. There is no way to separately reference a signature vs regular module; you get what you get. Only boot files can be referenced indepenently with `import {-# SOURCE #-}`. - - - - - 7750bd45 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Cmm: introduce SAVE_REGS/RESTORE_REGS We don't want to save both Fn and Dn register sets on x86-64 as they are aliased to the same arch register (XMMn). Moreover, when SAVE_STGREGS was used in conjunction with `jump foo [*]` which makes a set of Cmm registers alive so that they cover all arch registers used to pass parameter, we could have Fn, Dn and XMMn alive at the same time. It made the LLVM code generator choke (see #17920). Now `SAVE_REGS/RESTORE_REGS` and `jump foo [*]` use the same set of registers. - - - - - 2636794d by Sylvain Henry at 2020-06-23T22:48:18-04:00 CmmToC: don't add extern decl to parsed Cmm data Previously, if a .cmm file *not in the RTS* contained something like: ```cmm section "rodata" { msg : bits8[] "Test\n"; } ``` It would get compiled by CmmToC into: ```c ERW_(msg); const char msg[] = "Test\012"; ``` and fail with: ``` /tmp/ghc32129_0/ghc_4.hc:5:12: error: error: conflicting types for \u2018msg\u2019 const char msg[] = "Test\012"; ^~~ In file included from /tmp/ghc32129_0/ghc_4.hc:3:0: error: /tmp/ghc32129_0/ghc_4.hc:4:6: error: note: previous declaration of \u2018msg\u2019 was here ERW_(msg); ^ /builds/hsyl20/ghc/_build/install/lib/ghc-8.11.0.20200605/lib/../lib/x86_64-linux-ghc-8.11.0.20200605/rts-1.0/include/Stg.h:253:46: error: note: in definition of macro \u2018ERW_\u2019 #define ERW_(X) extern StgWordArray (X) ^ ``` See the rationale for this on https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes Now we don't generate these extern declarations (ERW_, etc.) for top-level data. It shouldn't change anything for the RTS (the only place we use .cmm files) as it is already special cased in `GHC.Cmm.CLabel.needsCDecl`. And hand-written Cmm can use explicit extern declarations when needed. Note that it allows `cgrun069` test to pass with CmmToC (cf #15467). - - - - - 5f6a0665 by Sylvain Henry at 2020-06-23T22:48:18-04:00 LLVM: refactor and comment register padding code (#17920) - - - - - cad62ef1 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Add tests for #17920 Metric Decrease: T12150 T12234 - - - - - a2a9006b by Xavier Denis at 2020-06-23T22:48:56-04:00 Fix issue #18262 by zonking constraints after solving Zonk residual constraints in checkForExistence to reveal user type errors. Previously when `:instances` was used with instances that have TypeError constraints the result would look something like: instance [safe] s0 => Err 'A -- Defined at ../Bug2.hs:8:10 whereas after zonking, `:instances` now sees the `TypeError` and properly eliminates the constraint from the results. - - - - - 181516bc by Simon Peyton Jones at 2020-06-23T22:49:33-04:00 Fix a buglet in Simplify.simplCast This bug, revealed by #18347, is just a missing update to sc_hole_ty in simplCast. I'd missed a code path when I made the recentchanges in commit 6d49d5be904c0c01788fa7aae1b112d5b4dfaf1c Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Thu May 21 12:53:35 2020 +0100 Implement cast worker/wrapper properly The fix is very easy. Two other minor changes * Tidy up in SimpleOpt.simple_opt_expr. In fact I think this is an outright bug, introduced in the fix to #18112: we were simplifying the same coercion twice *with the same substitution*, which is just wrong. It'd be a hard bug to trigger, so I just fixed it; less code too. * Better debug printing of ApplyToVal - - - - - 625a7f54 by Simon Peyton Jones at 2020-06-23T22:50:11-04:00 Two small tweaks to Coercion.simplifyArgsWorker These tweaks affect the inner loop of simplifyArgsWorker, which in turn is called from the flattener in Flatten.hs. This is a key perf bottleneck to T9872{a,b,c,d}. These two small changes have a modest but useful benefit. No change in functionality whatsoever. Relates to #18354 - - - - - b5768cce by Sylvain Henry at 2020-06-23T22:50:49-04:00 Don't use timesInt2# with GHC < 8.11 (fix #18358) - - - - - 7ad4085c by Sylvain Henry at 2020-06-23T22:51:27-04:00 Fix invalid printf format - - - - - a1f34d37 by Krzysztof Gogolewski at 2020-06-23T22:52:09-04:00 Add missing entry to freeNamesItem (#18369) - - - - - 03a708ba by Andreas Klebinger at 2020-06-25T03:54:37-04:00 Enable large address space optimization on windows. Starting with Win 8.1/Server 2012 windows no longer preallocates page tables for reserverd memory eagerly, which prevented us from using this approach in the past. We also try to allocate the heap high in the memory space. Hopefully this makes it easier to allocate things in the low 4GB of memory that need to be there. Like jump islands for the linker. - - - - - 7e6d3d09 by Roland Senn at 2020-06-25T03:54:38-04:00 In `:break ident` allow out of scope and nested identifiers (Fix #3000) This patch fixes the bug and implements the feature request of #3000. 1. If `Module` is a real module name and `identifier` a name of a top-level function in `Module` then `:break Module.identifer` works also for an `identifier` that is out of scope. 2. Extend the syntax for `:break identifier` to: :break [ModQual.]topLevelIdent[.nestedIdent]...[.nestedIdent] `ModQual` is optional and is either the effective name of a module or the local alias of a qualified import statement. `topLevelIdent` is the name of a top level function in the module referenced by `ModQual`. `nestedIdent` is optional and the name of a function nested in a let or where clause inside the previously mentioned function `nestedIdent` or `topLevelIdent`. If `ModQual` is a module name, then `topLevelIdent` can be any top level identifier in this module. If `ModQual` is missing or a local alias of a qualified import, then `topLevelIdent` must be in scope. Breakpoints can be set on arbitrarily deeply nested functions, but the whole chain of nested function names must be specified. 3. To support the new functionality rewrite the code to tab complete `:break`. - - - - - 30e42652 by Ben Gamari at 2020-06-25T03:54:39-04:00 make: Respect XELATEX variable Previously we simply ignored the XELATEX variable when building PDF documentation. - - - - - 4acc2934 by Ben Gamari at 2020-06-25T03:54:39-04:00 hadrian/make: Detect makeindex Previously we would simply assume that makeindex was available. Now we correctly detect it in `configure` and respect this conclusion in hadrian and make. - - - - - 0d61f866 by Simon Peyton Jones at 2020-06-25T03:54:40-04:00 Expunge GhcTcId GHC.Hs.Extension had type GhcPs = GhcPass 'Parsed type GhcRn = GhcPass 'Renamed type GhcTc = GhcPass 'Typechecked type GhcTcId = GhcTc The last of these, GhcTcId, is a vestige of the past. This patch expunges it from GHC. - - - - - 8ddbed4a by Adam Wespiser at 2020-06-25T03:54:40-04:00 add examples to Data.Traversable - - - - - 284001d0 by Oleg Grenrus at 2020-06-25T03:54:42-04:00 Export readBinIface_ - - - - - 90f43872 by Zubin Duggal at 2020-06-25T03:54:43-04:00 Export everything from HsToCore. This lets us reuse these functions in haddock, avoiding synchronization bugs. Also fixed some divergences with haddock in that file Updates haddock submodule - - - - - c7dd6da7 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part1) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Hs.* - GHC.Core.* - GHC.Stg.* - GHC.Cmm.* - GHC.Types.* - GHC.Data.* - GHC.Builtin.* - GHC.Parser.* - GHC.Driver.* - GHC top - - - - - 1eb997a8 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part2) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Iface.* - GHC.Llvm.* - GHC.Rename.* - GHC.Tc.* - GHC.HsToCore.* - GHC.StgToCmm.* - GHC.CmmToAsm.* - GHC.Runtime.* - GHC.Unit.* - GHC.Utils.* - GHC.SysTools.* - - - - - 67a86b4d by Oleg Grenrus at 2020-06-25T03:54:46-04:00 Add MonadZip and MonadFix instances for Complex These instances are taken from https://hackage.haskell.org/package/linear-1.21/docs/Linear-Instances.html They are the unique possible, so let they be in `base`. - - - - - c50ef26e by Artem Pelenitsyn at 2020-06-25T03:54:47-04:00 test suite: add reproducer for #17516 - - - - - fe281b27 by Roland Senn at 2020-06-25T03:54:48-04:00 Enable maxBound checks for OverloadedLists (Fixes #18172) Consider the Literal `[256] :: [Data.Word.Word8]` When the `OverloadedLists` extension is not active, then the `ol_ext` field in the `OverLitTc` record that is passed to the function `getIntegralLit` contains the type `Word8`. This is a simple type, and we can use its type constructor immediately for the `warnAboutOverflowedLiterals` function. When the `OverloadedLists` extension is active, then the `ol_ext` field contains the type family `Item [Word8]`. The function `nomaliseType` is used to convert it to the needed type `Word8`. - - - - - a788d4d1 by Ben Gamari at 2020-06-25T03:54:52-04:00 rts/Hash: Simplify freeing of HashListChunks While looking at #18348 I noticed that the treatment of HashLists are a bit more complex than necessary (which lead to some initial confusion on my part). Specifically, we allocate HashLists in chunks. Each chunk allocation makes two allocations: one for the chunk itself and one for a HashListChunk to link together the chunks for the purposes of freeing. Simplify this (and hopefully make the relationship between these clearer) but allocating the HashLists and HashListChunk in a single malloc. This will both make the implementation easier to follow and reduce C heap fragmentation. Note that even after this patch we fail to bound the size of the free HashList pool. However, this is a separate bug. - - - - - d3c2d59b by Sylvain Henry at 2020-06-25T03:54:55-04:00 RTS: avoid overflow on 32-bit arch (#18375) We're now correctly computing allocated bytes on 32-bit arch, so we get huge increases. Metric Increase: haddock.Cabal haddock.base haddock.compiler space_leak_001 - - - - - a3d69dc6 by Sebastian Graf at 2020-06-25T23:06:18-04:00 GHC.Core.Unify: Make UM actions one-shot by default This MR makes the UM monad in GHC.Core.Unify into a one-shot monad. See the long Note [The one-shot state monad trick]. See also #18202 and !3309, which applies this to all Reader/State-like monads in GHC for compile-time perf improvements. The pattern used here enables something similar to the state-hack, but is applicable to user-defined monads, not just `IO`. Metric Decrease 'runtime/bytes allocated' (test_env='i386-linux-deb9'): haddock.Cabal - - - - - 9ee58f8d by Matthias Pall Gissurarson at 2020-06-26T17:12:45+00:00 Implement the proposed -XQualifiedDo extension Co-authored-by: Facundo Domínguez <facundo.dominguez at tweag.io> QualifiedDo is implemented using the same placeholders for operation names in the AST that were devised for RebindableSyntax. Whenever the renamer checks which names to use for do syntax, it first checks if the do block is qualified (e.g. M.do { stmts }), in which case it searches for qualified names in the module M. This allows users to write {-# LANGUAGE QualifiedDo #-} import qualified SomeModule as M f x = M.do -- desugars to: y <- M.return x -- M.return x M.>>= \y -> M.return y -- M.return y M.>> M.return y -- M.return y See Note [QualifiedDo] and the users' guide for more details. Issue #18214 Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0216-qualified-do.rst Since we change the constructors `ITdo` and `ITmdo` to carry the new module name, we need to bump the haddock submodule to account or the new shape of these constructors. - - - - - ce987865 by Ryan Scott at 2020-06-27T11:55:21-04:00 Revamp the treatment of auxiliary bindings for derived instances This started as a simple fix for #18321 that organically grew into a much more sweeping refactor of how auxiliary bindings for derived instances are handled. I have rewritten `Note [Auxiliary binders]` in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but the highlights are: * Previously, the OccName of each auxiliary binding would be given a suffix containing a hash of its package name, module name, and parent data type to avoid name clashes. This was needlessly complicated, so we take the more direct approach of generating `Exact` `RdrName`s for each auxiliary binding with the same `OccName`, but using an underlying `System` `Name` with a fresh `Unique` for each binding. Unlike hashes, allocating new `Unique`s does not require any cleverness and avoid name clashes all the same... * ...speaking of which, in order to convince the renamer that multiple auxiliary bindings with the same `OccName` (but different `Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of `rnTopBindsLHS` to rename auxiliary bindings. Again, see `Note [Auxiliary binders]` for the full story. * I have removed the `DerivHsBind` constructor for `DerivStuff`—which was only used for `Data.Data`-related auxiliary bindings—and refactored `gen_Data_binds` to use `DerivAuxBind` instead. This brings the treatment of `Data.Data`-related auxiliary bindings in line with every other form of auxiliary binding. Fixes #18321. - - - - - a403eb91 by Sylvain Henry at 2020-06-27T11:55:59-04:00 ghc-bignum: fix division by zero (#18359) - - - - - 1b3d13b6 by Sylvain Henry at 2020-06-27T11:55:59-04:00 Fix ghc-bignum exceptions We must ensure that exceptions are not simplified. Previously we used: case raiseDivZero of _ -> 0## -- dummyValue But it was wrong because the evaluation of `raiseDivZero` was removed and the dummy value was directly returned. See new Note [ghc-bignum exceptions]. I've also removed the exception triggering primops which were fragile. We don't need them to be primops, we can have them exported by ghc-prim. I've also added a test for #18359 which triggered this patch. - - - - - a74ec37c by Simon Peyton Jones at 2020-06-27T11:56:34-04:00 Better loop detection in findTypeShape Andreas pointed out, in !3466, that my fix for #18304 was not quite right. This patch fixes it properly, by having just one RecTcChecker rather than (implicitly) two nested ones, in findTypeShape. - - - - - a04020b8 by Sylvain Henry at 2020-06-27T11:57:11-04:00 DynFlags: don't store buildTag `DynFlags.buildTag` was a field created from the set of Ways in `DynFlags.ways`. It had to be kept in sync with `DynFlags.ways` which was fragile. We want to avoid global state like this (#17957). Moreover in #14335 we also want to support loading units with different ways: target units would still use `DynFlags.ways` but plugins would use `GHC.Driver.Ways.hostFullWays`. To avoid having to deal both with build tag and with ways, we recompute the buildTag on-the-fly (should be pretty cheap) and we remove `DynFlags.buildTag` field. - - - - - 0e83efa2 by Krzysztof Gogolewski at 2020-06-27T11:57:49-04:00 Don't generalize when typechecking a tuple section The code is simpler and cleaner. - - - - - d8ba9e6f by Peter Trommler at 2020-06-28T09:19:11-04:00 RTS: Refactor Haskell-C glue for PPC 64-bit Make sure the stack is 16 byte aligned even when reserved stack bytes are not a multiple of 16 bytes. Avoid saving r2 (TOC). On ELF v1 the function descriptor of StgReturn has the same TOC as StgRun, on ELF v2 the TOC is recomputed in the function prologue. Use the ABI provided functions to save clobbered GPRs and FPRs. Improve comments. Describe what the stack looks like and how it relates to the respective ABIs. - - - - - 42f797b0 by Ryan Scott at 2020-06-28T09:19:46-04:00 Use NHsCoreTy to embed types into GND-generated code `GeneralizedNewtypeDeriving` is in the unique situation where it must produce an `LHsType GhcPs` from a Core `Type`. Historically, this was done with the `typeToLHsType` function, which walked over the entire `Type` and attempted to construct an `LHsType` with the same overall structure. `typeToLHsType` is quite complicated, however, and has been the subject of numerous bugs over the years (e.g., #14579). Luckily, there is an easier way to accomplish the same thing: the `XHsType` constructor of `HsType`. `XHsType` bundles an `NHsCoreTy`, which allows embedding a Core `Type` directly into an `HsType`, avoiding the need to laboriously convert from one to another (as `typeToLHsType` did). Moreover, renaming and typechecking an `XHsType` is simple, since one doesn't need to do anything to a Core `Type`... ...well, almost. For the reasons described in `Note [Typechecking NHsCoreTys]` in `GHC.Tc.Gen.HsType`, we must apply a substitution that we build from the local `tcl_env` type environment. But that's a relatively modest price to pay. Now that `GeneralizedNewtypeDeriving` uses `NHsCoreTy`, the `typeToLHsType` function no longer has any uses in GHC, so this patch rips it out. Some additional tweaks to `hsTypeNeedsParens` were necessary to make the new `-ddump-deriv` output correctly parenthesized, but other than that, this patch is quite straightforward. This is a mostly internal refactoring, although it is likely that `GeneralizedNewtypeDeriving`-generated code will now need fewer language extensions in certain situations than it did before. - - - - - 68530b1c by Jan Hrček at 2020-06-28T09:20:22-04:00 Fix duplicated words and typos in comments and user guide - - - - - 15b79bef by Ryan Scott at 2020-06-28T09:20:57-04:00 Add integer-gmp's ghc.mk and GNUmakefile to .gitignore - - - - - bfa5698b by Simon Peyton Jones at 2020-06-28T09:21:32-04:00 Fix a typo in Lint This simple error in GHC.Core.Litn.lintJoinLams meant that Lint reported bogus errors. Fixes #18399 - - - - - 71006532 by Ryan Scott at 2020-06-30T07:10:42-04:00 Reject nested foralls/contexts in instance types more consistently GHC is very wishy-washy about rejecting instance declarations with nested `forall`s or contexts that are surrounded by outermost parentheses. This can even lead to some strange interactions with `ScopedTypeVariables`, as demonstrated in #18240. This patch makes GHC more consistently reject instance types with nested `forall`s/contexts so as to prevent these strange interactions. On the implementation side, this patch tweaks `splitLHsInstDeclTy` and `getLHsInstDeclHead` to not look through parentheses, which can be semantically significant. I've added a `Note [No nested foralls or contexts in instance types]` in `GHC.Hs.Type` to explain why. This also introduces a `no_nested_foralls_contexts_err` function in `GHC.Rename.HsType` to catch nested `forall`s/contexts in instance types. This function is now used in `rnClsInstDecl` (for ordinary instance declarations) and `rnSrcDerivDecl` (for standalone `deriving` declarations), the latter of which fixes #18271. On the documentation side, this adds a new "Formal syntax for instance declaration types" section to the GHC User's Guide that presents a BNF-style grammar for what is and isn't allowed in instance types. Fixes #18240. Fixes #18271. - - - - - bccf3351 by Sylvain Henry at 2020-06-30T07:10:46-04:00 Add ghc-bignum to 8.12 release notes - - - - - 81704a6f by David Eichmann at 2020-06-30T07:10:48-04:00 Update ssh keys in CI performance metrics upload script - - - - - 85310fb8 by Joshua Price at 2020-06-30T07:10:49-04:00 Add missing Ix instances for tuples of size 6 through 15 (#16643) - - - - - cbb6b62f by Vladislav Zavialov at 2020-07-01T15:41:38-04:00 Implement -XLexicalNegation (GHC Proposal #229) This patch introduces a new extension, -XLexicalNegation, which detects whether the minus sign stands for negation or subtraction using the whitespace-based rules described in GHC Proposal #229. Updates haddock submodule. - - - - - fb5a0d01 by Martin Handley at 2020-07-01T15:42:14-04:00 #17169: Clarify Fixed's Enum instance. - - - - - b316804d by Simon Peyton Jones at 2020-07-01T15:42:49-04:00 Improve debug tracing for substitution This patch improves debug tracing a bit (#18395) * Remove the ancient SDoc argument to substitution, replacing it with a HasDebugCallStack constraint. The latter does the same job (indicate the call site) but much better. * Add HasDebugCallStack to simpleOptExpr, exprIsConApp_maybe I needed this to help nail the lookupIdSubst panic in #18326, #17784 - - - - - 5c9fabb8 by Hécate at 2020-07-01T15:43:25-04:00 Add most common return values for `os` and `arch` - - - - - 76d8cc74 by Ryan Scott at 2020-07-01T15:44:01-04:00 Desugar quoted uses of DerivingVia and expression type signatures properly The way that `GHC.HsToCore.Quote` desugared quoted `via` types (e.g., `deriving via forall a. [a] instance Eq a => Eq (List a)`) and explicit type annotations in signatures (e.g., `f = id @a :: forall a. a -> a`) was completely wrong, as it did not implement the scoping guidelines laid out in `Note [Scoped type variables in bindings]`. This is easily fixed. While I was in town, I did some minor cleanup of related Notes: * `Note [Scoped type variables in bindings]` and `Note [Scoped type variables in class and instance declarations]` say very nearly the same thing. I decided to just consolidate the two Notes into `Note [Scoped type variables in quotes]`. * `Note [Don't quantify implicit type variables in quotes]` is somewhat outdated, as it predates GHC 8.10, where the `forall`-or-nothing rule requires kind variables to be explicitly quantified in the presence of an explicit `forall`. As a result, the running example in that Note doesn't even compile. I have changed the example to something simpler that illustrates the same point that the original Note was making. Fixes #18388. - - - - - 44d6a335 by Andreas Klebinger at 2020-07-02T02:54:54-04:00 T16012: Be verbose on failure. - - - - - f9853330 by Ryan Scott at 2020-07-02T02:55:29-04:00 Bump ghc-prim version to 0.7.0 Fixes #18279. Bumps the `text` submodule. - - - - - 23e4e047 by Sylvain Henry at 2020-07-02T10:46:31-04:00 Hadrian: fix PowerPC64le support (#17601) [ci skip] - - - - - 3cdd8d69 by Sylvain Henry at 2020-07-02T10:47:08-04:00 NCG: correctly handle addresses with huge offsets (#15570) Before this patch we could generate addresses of this form: movzbl cP0_str+-9223372036854775808,%eax The linker can't handle them because the offset is too large: ld.lld: error: Main.o:(.text+0xB3): relocation R_X86_64_32S out of range: -9223372036852653050 is not in [-2147483648, 2147483647] With this patch we detect those cases and generate: movq $-9223372036854775808,%rax addq $cP0_str,%rax movzbl (%rax),%eax I've also refactored `getAmode` a little bit to make it easier to understand and to trace. - - - - - 4d90b3ff by Gabor Greif at 2020-07-02T20:07:59-04:00 No need for CURSES_INCLUDE_DIRS This is a leftover from ef63ff27251a20ff11e58c9303677fa31e609a88 - - - - - f08d6316 by Sylvain Henry at 2020-07-02T20:08:36-04:00 Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function SCC profiling was enabled in a convoluted way: if WayProf was enabled, Opt_SccProfilingOn general flag was set (in `GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in various places. There is no need to go via general flags, so this patch defines a `sccProfilingEnabled :: DynFlags -> Bool` helper function that just checks whether WayProf is enabled. - - - - - 8cc7274b by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Only allocate the Censuses that we need When not LDV profiling there is no reason to allocate 32 Censuses; one will do. This is a very small memory footprint optimisation, but it comes for free. - - - - - b835112c by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Free old allocations when reinitialising Censuses Previously when not LDV profiling we would repeatedly reinitialise `censuses[0]` with `initEra`. This failed to free the `Arena` and `HashTable` from the old census, resulting in a memory leak. Fixes #18348. - - - - - 34be6523 by Valery Tolstov at 2020-07-03T02:50:03-04:00 Mention flags that are not enabled by -Wall (#18372) * Mention missing flags that are not actually enabled by -Wall (docs/users_guide/using-warnings.rst) * Additionally remove -Wmissing-monadfail-instances from the list of flags enabled by -Wcompat, as it is not the case since 8.8 - - - - - edc8d22b by Sylvain Henry at 2020-07-03T02:50:40-04:00 LLVM: support R9 and R10 registers d535ef006d85dbdb7cda2b09c5bc35cb80108909 allowed the use of up to 10 vanilla registers but didn't update LLVM backend to support them. This patch fixes it. - - - - - 4bf18646 by Simon Peyton Jones at 2020-07-03T08:37:42+01:00 Improve handling of data type return kinds Following a long conversation with Richard, this patch tidies up the handling of return kinds for data/newtype declarations (vanilla, family, and instance). I have substantially edited the Notes in TyCl, so they would bear careful reading. Fixes #18300, #18357 In GHC.Tc.Instance.Family.newFamInst we were checking some Lint-like properties with ASSSERT. Instead Richard and I have added a proper linter for axioms, and called it from lintGblEnv, which in turn is called in tcRnModuleTcRnM New tests (T18300, T18357) cause an ASSERT failure in HEAD. - - - - - 41d26492 by Sylvain Henry at 2020-07-03T17:33:59-04:00 DynFlags: avoid the use of sdocWithDynFlags in GHC.Core.Rules (#17957) - - - - - 7aa6ef11 by Hécate at 2020-07-03T17:34:36-04:00 Add the __GHC_FULL_VERSION__ CPP macro to expose the full GHC version - - - - - e61d5395 by Chaitanya Koparkar at 2020-07-07T13:55:59-04:00 ghc-prim: Turn some comments into haddocks [ci skip] - - - - - 37743f91 by John Ericson at 2020-07-07T13:56:00-04:00 Support `timesInt2#` in LLVM backend - - - - - 46397e53 by John Ericson at 2020-07-07T13:56:00-04:00 `genericIntMul2Op`: Call `genericWordMul2Op` directly This unblocks a refactor, and removes partiality. It might be a PowerPC regression but that should be fixable. - - - - - 8a1c0584 by John Ericson at 2020-07-07T13:56:00-04:00 Simplify `PrimopCmmEmit` Follow @simonpj's suggestion of pushing the "into regs" logic into `emitPrimOp`. With the previous commit getting rid of the recursion in `genericIntMul2Op`, this is now an easy refactor. - - - - - 6607f203 by John Ericson at 2020-07-07T13:56:00-04:00 `opAllDone` -> `opIntoRegs` The old name was and terrible and became worse after the previous commit's refactor moved non-trivial funcationlity into its body. - - - - - fdcc53ba by Sylvain Henry at 2020-07-07T13:56:00-04:00 Optimise genericIntMul2Op We shouldn't directly call 'genericWordMul2Op' in genericIntMul2Op because a target may provide a faster primop for 'WordMul2Op': we'd better use it! - - - - - 686e7225 by Moritz Angermann at 2020-07-07T13:56:01-04:00 [linker/rtsSymbols] More linker symbols Mostly symbols needed for aarch64/armv7l and in combination with musl, where we have to rely on loading *all* objects/archives - __stack_chk_* only when not DYNAMIC - - - - - 3f60b94d by Moritz Angermann at 2020-07-07T13:56:01-04:00 better if guards. - - - - - 7abffced by Moritz Angermann at 2020-07-07T13:56:01-04:00 Fix (1) - - - - - cdfeb3f2 by Moritz Angermann at 2020-07-07T13:56:01-04:00 AArch32 symbols only on aarch32. - - - - - f496c955 by Adam Sandberg Ericsson at 2020-07-07T13:56:02-04:00 add -flink-rts flag to link the rts when linking a shared or static library #18072 By default we don't link the RTS when linking shared libraries because in the most usual mode a shared library is an intermediary product, for example a Haskell library, that will be linked into some executable in the end. So we wish to defer the RTS flavour to link to the final link. However sometimes the final product is the shared library, for example when writing a plugin for some other system, so we do wish the shared library to link the RTS. For consistency we also make -staticlib honor this flag and its inversion. -staticlib currently implies -flink-shared. - - - - - c59faf67 by Stefan Schulze Frielinghaus at 2020-07-07T13:56:04-04:00 hadrian: link check-ppr against debugging RTS if ghcDebugged - - - - - 0effc57d by Adam Sandberg Ericsson at 2020-07-07T13:56:05-04:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 - - - - - 96153433 by Adam Sandberg Ericsson at 2020-07-07T13:56:06-04:00 hadrian: make hadrian/ghci use the bootstrap compiler from configure #18190 - - - - - 4d24f886 by Adam Sandberg Ericsson at 2020-07-07T13:56:07-04:00 hadrian: ignore cabal configure verbosity related flags #18131 - - - - - 7332bbff by Ben Gamari at 2020-07-07T13:56:08-04:00 testsuite: Widen T12234 acceptance window to 2% Previously it wasn't uncommon to see +/-1% fluctuations in compiler allocations on this test. - - - - - 180b6313 by Gabor Greif at 2020-07-07T13:56:08-04:00 When running libtool, report it as such - - - - - d3bd6897 by Sylvain Henry at 2020-07-07T13:56:11-04:00 BigNum: rename BigNat types Before this patch BigNat names were confusing because we had: * GHC.Num.BigNat.BigNat: unlifted type used everywhere else * GHC.Num.BigNat.BigNatW: lifted type only used to share static constants * GHC.Natural.BigNat: lifted type only used for backward compatibility After this patch we have: * GHC.Num.BigNat.BigNat#: unlifted type * GHC.Num.BigNat.BigNat: lifted type (reexported from GHC.Natural) Thanks to @RyanGlScott for spotting this. - - - - - 929d26db by Sylvain Henry at 2020-07-07T13:56:12-04:00 Bignum: don't build ghc-bignum with stage0 Noticed by @Ericson2314 - - - - - d25b6851 by Sylvain Henry at 2020-07-07T13:56:12-04:00 Hadrian: ghc-gmp.h shouldn't be a compiler dependency - - - - - 0ddae2ba by Sylvain Henry at 2020-07-07T13:56:14-04:00 DynFlags: factor out pprUnitId from "Outputable UnitId" instance - - - - - 204f3f5d by Krzysztof Gogolewski at 2020-07-07T13:56:18-04:00 Remove unused function pprHsForAllExtra (#18423) The function `pprHsForAllExtra` was called only on `Nothing` since 2015 (1e041b7382b6aa). - - - - - 3033e0e4 by Adam Sandberg Ericsson at 2020-07-08T20:36:49-04:00 hadrian: add flag to skip rebuilding dependency information #17636 - - - - - b7de4b96 by Stefan Schulze Frielinghaus at 2020-07-09T09:49:22-04:00 Fix GHCi :print on big-endian platforms On big-endian platforms executing import GHC.Exts data Foo = Foo Float# deriving Show foo = Foo 42.0# foo :print foo results in an arithmetic overflow exception which is caused by function index where moveBytes equals word_size - (r + item_size_b) * 8 Here we have a mixture of units. Both, word_size and item_size_b have unit bytes whereas r has unit bits. On 64-bit platforms moveBytes equals then 8 - (0 + 4) * 8 which results in a negative and therefore invalid second parameter for a shiftL operation. In order to make things more clear the expression (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes is equivalent to (word `shiftR` moveBytes) .&. mask On big-endian platforms the shift must be a left shift instead of a right shift. For symmetry reasons not a mask is used but two shifts in order to zero out bits. Thus the fixed version equals case endian of BigEndian -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits Fixes #16548 and #14455 - - - - - 3656dff8 by Sylvain Henry at 2020-07-09T09:50:01-04:00 LLVM: fix MO_S_Mul2 support (#18434) The value indicating if the carry is useful wasn't taken into account. - - - - - d9f09506 by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Define multiShotIO and use it in mkSplitUniqueSupply This patch is part of the ongoing eta-expansion saga; see #18238. It implements a neat trick (suggested by Sebastian Graf) that allows the programmer to disable the default one-shot behaviour of IO (the "state hack"). The trick is to use a new multiShotIO function; see Note [multiShotIO]. For now, multiShotIO is defined here in Unique.Supply; but it should ultimately be moved to the IO library. The change is necessary to get good code for GHC's unique supply; see Note [Optimising the unique supply]. However it makes no difference to GHC as-is. Rather, it makes a difference when a subsequent commit Improve eta-expansion using ArityType lands. - - - - - bce695cc by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Make arityType deal with join points As Note [Eta-expansion and join points] describes, this patch makes arityType deal correctly with join points. What was there before was not wrong, but yielded lower arities than it could. Fixes #18328 In base GHC this makes no difference to nofib. Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- n-body -0.1% -0.1% -1.2% -1.1% 0.0% -------------------------------------------------------------------------------- Min -0.1% -0.1% -55.0% -56.5% 0.0% Max -0.0% 0.0% +16.1% +13.4% 0.0% Geometric Mean -0.0% -0.0% -30.1% -31.0% -0.0% But it starts to make real difference when we land the change to the way mkDupableAlts handles StrictArg, in fixing #13253 and friends. I think this is because we then get more non-inlined join points. - - - - - 2b7c71cb by Simon Peyton Jones at 2020-07-11T12:17:02-04:00 Improve eta-expansion using ArityType As #18355 shows, we were failing to preserve one-shot info when eta-expanding. It's rather easy to fix, by using ArityType more, rather than just Arity. This patch is important to suport the one-shot monad trick; see #18202. But the extra tracking of one-shot-ness requires the patch Define multiShotIO and use it in mkSplitUniqueSupply If that patch is missing, ths patch makes things worse in GHC.Types.Uniq.Supply. With it, however, we see these improvements T3064 compiler bytes allocated -2.2% T3294 compiler bytes allocated -1.3% T12707 compiler bytes allocated -1.3% T13056 compiler bytes allocated -2.2% Metric Decrease: T3064 T3294 T12707 T13056 - - - - - de139cc4 by Artem Pelenitsyn at 2020-07-12T02:53:20-04:00 add reproducer for #15630 - - - - - c4de6a7a by Andreas Klebinger at 2020-07-12T02:53:55-04:00 Give Uniq[D]FM a phantom type for its key. This fixes #17667 and should help to avoid such issues going forward. The changes are mostly mechanical in nature. With two notable exceptions. * The register allocator. The register allocator references registers by distinct uniques. However they come from the types of VirtualReg, Reg or Unique in various places. As a result we sometimes cast the key type of the map and use functions which operate on the now typed map but take a raw Unique as actual key. The logic itself has not changed it just becomes obvious where we do so now. * <Type>Env Modules. As an example a ClassEnv is currently queried using the types `Class`, `Name`, and `TyCon`. This is safe since for a distinct class value all these expressions give the same unique. getUnique cls getUnique (classTyCon cls) getUnique (className cls) getUnique (tcName $ classTyCon cls) This is for the most part contained within the modules defining the interface. However it requires us to play dirty when we are given a `Name` to lookup in a `UniqFM Class a` map. But again the logic did not change and it's for the most part hidden behind the Env Module. Some of these cases could be avoided by refactoring but this is left for future work. We also bump the haddock submodule as it uses UniqFM. - - - - - c2cfdfde by Aaron Allen at 2020-07-13T09:00:33-04:00 Warn about empty Char enumerations (#18402) Currently the "Enumeration is empty" warning (-Wempty-enumerations) only fires for numeric literals. This patch adds support for `Char` literals so that enumerating an empty list of `Char`s will also trigger the warning. - - - - - c3ac87ec by Stefan Schulze Frielinghaus at 2020-07-13T09:01:10-04:00 hadrian: build check-ppr dynamic if GHC is build dynamic Fixes #18361 - - - - - 9ad072b4 by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Use dumpStyle when printing inlinings This just makes debug-printing consistent, and more informative. - - - - - e78c4efb by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Comments only - - - - - 7ccb760b by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Reduce result discount in conSize Ticket #18282 showed that the result discount given by conSize was massively too large. This patch reduces that discount to a constant 10, which just balances the cost of the constructor application itself. Note [Constructor size and result discount] elaborates, as does the ticket #18282. Reducing result discount reduces inlining, which affects perf. I found that I could increase the unfoldingUseThrehold from 80 to 90 in compensation; in combination with the result discount change I get these overall nofib numbers: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- boyer -0.2% +5.4% -3.2% -3.4% 0.0% cichelli -0.1% +5.9% -11.2% -11.7% 0.0% compress2 -0.2% +9.6% -6.0% -6.8% 0.0% cryptarithm2 -0.1% -3.9% -6.0% -5.7% 0.0% gamteb -0.2% +2.6% -13.8% -14.4% 0.0% genfft -0.1% -1.6% -29.5% -29.9% 0.0% gg -0.0% -2.2% -17.2% -17.8% -20.0% life -0.1% -2.2% -62.3% -63.4% 0.0% mate +0.0% +1.4% -5.1% -5.1% -14.3% parser -0.2% -2.1% +7.4% +6.7% 0.0% primetest -0.2% -12.8% -14.3% -14.2% 0.0% puzzle -0.2% +2.1% -10.0% -10.4% 0.0% rsa -0.2% -11.7% -3.7% -3.8% 0.0% simple -0.2% +2.8% -36.7% -38.3% -2.2% wheel-sieve2 -0.1% -19.2% -48.8% -49.2% -42.9% -------------------------------------------------------------------------------- Min -0.4% -19.2% -62.3% -63.4% -42.9% Max +0.3% +9.6% +7.4% +11.0% +16.7% Geometric Mean -0.1% -0.3% -17.6% -18.0% -0.7% I'm ok with these numbers, remembering that this change removes an *exponential* increase in code size in some in-the-wild cases. I investigated compress2. The difference is entirely caused by this function no longer inlining WriteRoutines.$woutputCodes = \ (w :: [CodeEvent]) -> let result_s1Sr = case WriteRoutines.outputCodes_$s$woutput w 0# 0# 8# 9# of (# ww1, ww2 #) -> (ww1, ww2) in (# case result_s1Sr of (x, _) -> map @Int @Char WriteRoutines.outputCodes1 x , case result_s1Sr of { (_, y) -> y } #) It was right on the cusp before, driven by the excessive result discount. Too bad! Happily, the compiler/perf tests show a number of improvements: T12227 compiler bytes-alloc -6.6% T12545 compiler bytes-alloc -4.7% T13056 compiler bytes-alloc -3.3% T15263 runtime bytes-alloc -13.1% T17499 runtime bytes-alloc -14.3% T3294 compiler bytes-alloc -1.1% T5030 compiler bytes-alloc -11.7% T9872a compiler bytes-alloc -2.0% T9872b compiler bytes-alloc -1.2% T9872c compiler bytes-alloc -1.5% Metric Decrease: T12227 T12545 T13056 T15263 T17499 T3294 T5030 T9872a T9872b T9872c - - - - - 7f0b671e by Ben Gamari at 2020-07-13T14:52:49-04:00 testsuite: Widen acceptance threshold on T5837 This test is positively tiny and consequently the bytes allocated measurement will be relatively noisy. Consequently I have seen this fail spuriously quite often. - - - - - 118e1c3d by Alp Mestanogullari at 2020-07-14T21:30:52-04:00 compiler: re-engineer the treatment of rebindable if Executing on the plan described in #17582, this patch changes the way if expressions are handled in the compiler in the presence of rebindable syntax. We get rid of the SyntaxExpr field of HsIf and instead, when rebindable syntax is on, we rewrite the HsIf node to the appropriate sequence of applications of the local `ifThenElse` function. In order to be able to report good error messages, with expressions as they were written by the user (and not as desugared by the renamer), we make use of TTG extensions to extend GhcRn expression ASTs with an `HsExpansion` construct, which keeps track of a source (GhcPs) expression and the desugared (GhcRn) expression that it gives rise to. This way, we can typecheck the latter while reporting the former in error messages. In order to discard the error context lines that arise from typechecking the desugared expressions (because they talk about expressions that the user has not written), we carefully give a special treatment to the nodes fabricated by this new renaming-time transformation when typechecking them. See Note [Rebindable syntax and HsExpansion] for more details. The note also includes a recipe to apply the same treatment to other rebindable constructs. Tests 'rebindable11' and 'rebindable12' have been added to make sure we report identical error messages as before this patch under various circumstances. We also now disable rebindable syntax when processing untyped TH quotes, as per the discussion in #18102 and document the interaction of rebindable syntax and Template Haskell, both in Note [Template Haskell quotes and Rebindable Syntax] and in the user guide, adding a test to make sure that we do not regress in that regard. - - - - - 64c774b0 by Andreas Klebinger at 2020-07-14T21:31:27-04:00 Explain why keeping DynFlags in AnalEnv saves allocation. - - - - - 254245d0 by Ben Gamari at 2020-07-14T21:32:03-04:00 docs/users-guide: Update default -funfolding-use-threshold value This was changed in 3d2991f8 but I neglected to update the documentation. Fixes #18419. - - - - - 4c259f86 by Andreas Klebinger at 2020-07-14T21:32:41-04:00 Escape backslashes in json profiling reports properly. I also took the liberty to do away the fixed buffer size for escaping. Using a fixed size here can only lead to issues down the line. Fixes #18438. - - - - - 23797224 by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 .gitlab: re-enable integer-simple substitute (BIGNUM_BACKEND) Recently build system migrated from INTEGER_LIBRARY to BIGNUM_BACKEND. But gitlab CI was never updated. Let's enable BIGNUM_BACKEND=native. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e0db878a by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 ghc-bignum: bring in sync .hs-boot files with module declarations Before this change `BIGNUM_BACKEND=native` build was failing as: ``` libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs:708:16: error: * Variable not in scope: naturalFromBigNat# :: WordArray# -> t * Perhaps you meant one of these: `naturalFromBigNat' (imported from GHC.Num.Natural), `naturalToBigNat' (imported from GHC.Num.Natural) | 708 | m' = naturalFromBigNat# m | ``` This happens because `.hs-boot` files are slightly out of date. This change brings in data and function types in sync. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - c9f65c36 by Stefan Schulze Frielinghaus at 2020-07-14T21:33:57-04:00 rts/Disassembler.c: Use FMT_HexWord for printing values in hex format - - - - - 58ae62eb by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 macOS: Load frameworks without stating them first. macOS Big Sur makes the following change to how frameworks are shipped with the OS: > New in macOS Big Sur 11 beta, the system ships with a built-in > dynamic linker cache of all system-provided libraries. As part of > this change, copies of dynamic libraries are no longer present on > the filesystem. Code that attempts to check for dynamic library > presence by looking for a file at a path or enumerating a directory > will fail. Instead, check for library presence by attempting to > dlopen() the path, which will correctly check for the library in the > cache. (62986286) https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/ Therefore, the previous method of checking whether a library exists before attempting to load it makes GHC.Runtime.Linker.loadFramework fail to find frameworks installed at /System/Library/Frameworks. GHC.Runtime.Linker.loadFramework now opportunistically loads the framework libraries without checking for their existence first, failing only if all attempts to load a given framework from any of the various possible locations fail. - - - - - cdc4a6b0 by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 loadFramework: Output the errors collected in all loading attempts. With the recent change away from first finding and then loading a framework, loadFramework had no way of communicating the real reason why loadDLL failed if it was any reason other than the framework missing from the file system. It now collects all loading attempt errors into a list and concatenates them into a string to return to the caller. - - - - - 51dbfa52 by Ben Gamari at 2020-07-15T04:05:34-04:00 StgToCmm: Use CmmRegOff smart constructor Previously we would generate expressions of the form `CmmRegOff BaseReg 0`. This should do no harm (and really should be handled by the NCG anyways) but it's better to just generate a plain `CmmReg`. - - - - - ae11bdfd by Ben Gamari at 2020-07-15T04:06:08-04:00 testsuite: Add regression test for #17744 Test due to @monoidal. - - - - - 0e3c277a by Ben Gamari at 2020-07-15T16:41:01-04:00 Bump Cabal submodule Updates a variety of tests as Cabal is now more strict about Cabal file form. - - - - - ceed994a by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Drop Windows Vista support, require Windows 7 - - - - - 00a23bfd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Update Windows FileSystem wrapper utilities. - - - - - 459e1c5f by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Use SlimReaderLocks and ConditonalVariables provided by the OS instead of emulated ones - - - - - 763088fc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Small linker comment and ifdef cleanups - - - - - 1a228ff9 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Flush event logs eagerly. - - - - - e9e04dda by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Refactor Buffer structures to be able to track async operations - - - - - 356dc3fe by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Implement new Console API - - - - - 90e69f77 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add IOPort synchronization primitive - - - - - 71245fcc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add new io-manager cmdline options - - - - - d548a3b3 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Init Windows console Codepage to UTF-8. - - - - - 58ef6366 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add unsafeSplat to GHC.Event.Array - - - - - d660725e by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add size and iterate to GHC.Event.IntTable. - - - - - 050da6dd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Switch Testsuite to test winio by default - - - - - 4bf542bf by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Multiple refactorings and support changes. - - - - - 4489af6b by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core threaded I/O manager - - - - - 64d8f2fe by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core non-threaded I/O manager - - - - - 8da15a09 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix a scheduler bug with the threaded-runtime. - - - - - 84ea3d14 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Relaxing some constraints in io-manager. - - - - - ccf0d107 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix issues with non-threaded I/O manager after split. - - - - - b492fe6e by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Remove some barf statements that are a bit strict. - - - - - 01423fd2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Expand comments describing non-threaded loop - - - - - 4b69004f by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: fix FileSize unstat-able handles - - - - - 9b384270 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Implement new tempfile routines for winio - - - - - f1e0be82 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix input truncation when reading from handle. This was caused by not upholding the read buffer invariant that bufR == bufL == 0 for empty read buffers. - - - - - e176b625 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix output truncation for writes larger than buffer size - - - - - a831ce0e by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Rewrite bufWrite. I think it's far easier to follow the code now. It's also correct now as I had still missed a spot where we didn't update the offset. - - - - - 6aefdf62 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix offset set by bufReadEmpty. bufReadEmpty returns the bytes read *including* content that was already buffered, But for calculating the offset we only care about the number of bytes read into the new buffer. - - - - - 750ebaee by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Clean up code surrounding IOPort primitives. According to phyx these should only be read and written once per object. Not neccesarily in that order. To strengthen that guarantee the primitives will now throw an exception if we violate this invariant. As a consequence we can eliminate some code from their primops. In particular code dealing with multiple queued readers/writers now simply checks the invariant and throws an exception if it was violated. That is in contrast to mvars which will do things like wake up all readers, queue multi writers etc. - - - - - ffd31db9 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix multi threaded threadDelay and a few other small changes. Multithreaded threadDelay suffered from a race condition based on the ioManagerStatus. Since the status isn't needed for WIO I removed it completely. This resulted in a light refactoring, as consequence we will always wake up the IO manager using interruptSystemManager, which uses `postQueuedCompletionStatus` internally. I also added a few comments which hopefully makes the code easier to dive into for the next person diving in. - - - - - 6ec26df2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 wionio: Make IO subsystem check a no-op on non-windows platforms. - - - - - 29bcd936 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Set handle offset when opening files in Append mode. Otherwise we would truncate the file. - - - - - 55c29700 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Remove debug event log trace - - - - - 9acb9f40 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix sqrt and openFile009 test cases - - - - - 57017cb7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Allow hp2ps to build with -DDEBUG - - - - - b8cd9995 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update output of T9681 since we now actually run it. - - - - - 10af5b14 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: A few more improvements to the IOPort primitives. - - - - - 39afc4a7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix expected tempfiles output. Tempfiles now works properly on windows, as such we can delete the win32 specific output. - - - - - 99db46e0 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Assign thread labels to IOManager threads. - - - - - be6af732 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Properly check for the tso of an incall to be zero. - - - - - e2c6dac7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark FD instances as unsupported under WINIO. - - - - - fd02ceed by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix threadDelay maxBound invocations. Instead of letting the ns timer overflow now clamp it at (maxBound :: Word64) ns. That still gives a few hundred years. - - - - - bc79f9f1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comments/cleanup an import in base - - - - - 1d197f4b by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark outstanding_service_requests volatile. As far as I know C(99) gives no guarantees for code like bool condition; ... while(condition) sleep(); that condition will be updated if it's changed by another thread. So we are explicit here and mark it as volatile, this will force a reload from memory on each iteration. - - - - - dc438186 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Make last_event a local variable - - - - - 2fc957c5 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comment about thread safety of processCompletion. - - - - - 4c026b6c by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: nonthreaded: Create io processing threads in main thread. We now set a flag in the IO thread. The scheduler when looking for work will check the flag and create/queue threads accordingly. We used to create these in the IO thread. This improved performance but caused frequent segfaults. Thread creation/allocation is only safe to do if nothing currently accesses the storeagemanager. However without locks in the non-threaded runtime this can't be guaranteed. This shouldn't change performance all too much. In the past we had: * IO: Create/Queue thread. * Scheduler: Runs a few times. Eventually picks up IO processing thread. Now it's: * IO: Set flag to queue thread. * Scheduler: Pick up flag, if set create/queue thread. Eventually picks up IO processing thread. - - - - - f47c7208 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add an exported isHeapAlloced function to the RTS - - - - - cc5d7bb1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Queue IO processing threads at the front of the queue. This will unblock the IO thread sooner hopefully leading to higher throughput in some situations. - - - - - e7630115 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: ThreadDelay001: Use higher resolution timer. - - - - - 451b5f96 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update T9681 output, disable T4808 on windows. T4808 tests functionality of the FD interface which won't be supported under WINIO. T9681 just has it's expected output tweaked. - - - - - dd06f930 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Wake io manager once per registerTimeout. Which is implicitly done in editTimeouts, so need to wake it up twice. - - - - - e87d0bf9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update placeholder comment with actual function name. - - - - - fc9025db by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Always lock win32 event queue - - - - - c24c9a1f by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Display thread labels when tracing scheduler events. - - - - - 06542b03 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Refactor non-threaded runner thread and scheduler interface. Only use a single communication point (registerAlertableWait) to inform the C side aobut both timeouts to use as well as outstanding requests. Also queue a haskell processing thread after each return from alertable waits. This way there is no risk of us missing a timer event. - - - - - 256299b1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove outstanding_requests from runner. We used a variable to keep track of situations where we got entries from the IO port, but all of them had already been canceled. While we can avoid some work that way this case seems quite rare. So we give up on tracking this and instead always assume at least one of the returned entries is valid. If that's not the case no harm is done, we just perform some additional work. But it makes the runner easier to reason about. In particular we don't need to care if another thread modifies oustanding_requests after we return from waiting on the IO Port. - - - - - 3ebd8ad9 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Various fixes related to rebase and testdriver - - - - - 6be6bcba by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Fix rebase artifacts - - - - - 2c649dc3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename unsafeSplat to unsafeCopyFromBuffer - - - - - a18b73f3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove unused size/iterate operations from IntTable - - - - - 16bab48e by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Detect running IO Backend via peeking at RtsConfig - - - - - 8b8405a0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update temp path so GCC etc can handle it. Also fix PIPE support, clean up error casting, fix memory leaks - - - - - 2092bc54 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Minor comments/renamings - - - - - a5b5b6c0 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Checking if an error code indicates completion is now a function. - - - - - 362176fd by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Small refactor in withOverlappedEx - - - - - 32e20597 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: A few comments and commented out dbxIO - - - - - a4bfc1d9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't drop buffer offset in byteView/cwcharView - - - - - b3ad2a54 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: revert BHandle changes. - - - - - 3dcd87e2 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Fix imports - - - - - 5a371890 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update ghc-cabal to handle new Cabal submodule bump - - - - - d07ebe0d by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Only compile sources on Windows - - - - - dcb42393 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Actually return Nothing on EOF for non-blocking read - - - - - 895a3beb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate logic in encodeMultiByte[Raw]IO. - - - - - e06e6734 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate openFile logic - - - - - b59430c0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: fix -werror issue in encoding file - - - - - f8d39a51 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't mention windows specific functions when building on Linux. - - - - - 6a533d2a by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add a note about file locking in the RTS. - - - - - cf37ce34 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Add version to @since annotation - - - - - 0fafa2eb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename GHC.Conc.IOCP -> GHC.Conc.WinIO - - - - - 1854fc23 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Expand GHC.Conc.POSIX description It now explains users may not use these functions when using the old IO manager. - - - - - fcc7ba41 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Fix potential spaceleak in __createUUIDTempFileErrNo - - - - - 6b3fd9fa by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant -Wno-missing-signatures pragmas - - - - - 916fc861 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Make it explicit that we only create one IO manager - - - - - f260a721 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Note why we don't use blocking waits. - - - - - aa0a4bbf by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove commented out pragma - - - - - d679b544 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant buffer write in Handle/Text.hs:bufReadEmpty - - - - - d3f94368 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename SmartHandles to StdHandles - - - - - bd6b8ec1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add comment stating failure behaviour for getUniqueFileInfo. - - - - - 12846b85 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update IOPort haddocks. - - - - - 9f39fb14 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Add a note cross reference - - - - - 62dd5a73 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Name Haskell/OS I/O Manager explicitly in Note - - - - - fa807828 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Expand BlockedOnIOCompletion description. - - - - - f0880a1d by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove historical todos - - - - - 8e58e714 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Update note, remove debugging pragma. - - - - - aa4d84d5 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: flushCharReadBuffer shouldn't need to adjust offsets. - - - - - e580893a by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove obsolete comment about cond. variables - - - - - d54e9d79 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix initial linux validate build - - - - - 3cd4de46 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix ThreadDelay001 CPP - - - - - c88b1b9f by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix openFile009 merge conflict leftover - - - - - 849e8889 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept T9681 output. GHC now reports String instead of [Char]. - - - - - e7701818 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix cabal006 after upgrading cabal submodule Demand cabal 2.0 syntax instead of >= 1.20 as required by newer cabal versions. - - - - - a44f0373 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix stderr output for ghci/linking/dyn tests. We used to filter rtsopts, i opted to instead just accept the warning of it having no effect. This works both for -rtsopts, as well as -with-rtsopts which winio adds. - - - - - 515d9896 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T15261b stdout for --io-manager flag. - - - - - 949aaacc by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T5435_dyn_asm stderr The warning about rtsopts having no consequences is expected. So accept new stderr. - - - - - 7d424e1e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Also accept T7037 stderr - - - - - 1f009768 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal04 by filtering rts args - - - - - 981a9f2e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal01 by accepting expected stderr - - - - - b7b0464e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix safePkg01 by accepting expected stderr - - - - - 32734b29 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix T5435_dyn_gcc by accepting expected stderr - - - - - acc5cebf by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix tempfiles test on linux - - - - - c577b789 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for T3807 - - - - - c108c527 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload - - - - - 2b0b9a08 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload_multiple_objs - - - - - 67afb03c by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify wording on conditional variables. - - - - - 3bd41572 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify comment on cooked mode. - - - - - ded58a03 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: update lockfile signature and remove mistaken symbol in rts. - - - - - 2143c492 by Ben Gamari at 2020-07-15T16:41:04-04:00 testsuite: Add winio and winio_threaded ways Reverts many of the testsuite changes - - - - - c0979cc5 by Ben Gamari at 2020-07-16T10:56:54-04:00 Merge remote-tracking branch 'origin/wip/winio' - - - - - 750a1595 by Ben Gamari at 2020-07-18T07:26:41-04:00 rts: Add --copying-gc flag to reverse effect of --nonmoving-gc Fixes #18281. - - - - - 6ba6a881 by Hécate at 2020-07-18T07:26:42-04:00 Implement `fullCompilerVersion` Follow-up of https://gitlab.haskell.org/ghc/ghc/-/issues/18403 This MR adds `fullCompilerVersion`, a function that shares the same backend as the `--numeric-version` GHC flag, exposing a full, three-digit version datatype. - - - - - e6cf27df by Hécate at 2020-07-18T07:26:43-04:00 Add a Lint hadrian rule and an .hlint.yaml file in base/ - - - - - bcb177dd by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Allow multiple case branches to have a higher rank type As #18412 points out, it should be OK for multiple case alternatives to have a higher rank type, provided they are all the same. This patch implements that change. It sweeps away GHC.Tc.Gen.Match.tauifyMultipleBranches, and friends, replacing it with an enhanced version of fillInferResult. The basic change to fillInferResult is to permit the case in which another case alternative has already filled in the result; and in that case simply unify. It's very simple actually. See the new Note [fillInferResult] in TcMType Other refactoring: - Move all the InferResult code to one place, in GHC.Tc.Utils.TcMType (previously some of it was in Unify) - Move tcInstType and friends from TcMType to Instantiate, where it more properly belongs. (TCMType was getting very long.) - - - - - e5525a51 by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Improve typechecking of NPlusK patterns This patch (due to Richard Eisenberg) improves documentation of the wrapper returned by tcSubMult (see Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify). And, more substantially, it cleans up the multiplicity handling in the typechecking of NPlusKPat - - - - - 12f90352 by Krzysztof Gogolewski at 2020-07-18T07:26:45-04:00 Remove {-# CORE #-} pragma (part of #18048) This pragma has no effect since 2011. It was introduced for External Core, which no longer exists. Updates haddock submodule. - - - - - e504c913 by Simon Peyton Jones at 2020-07-18T07:26:45-04:00 Refactor the simplification of join binders This MR (for #18449) refactors the Simplifier's treatment of join-point binders. Specifically, it puts together, into GHC.Core.Opt.Simplify.Env.adjustJoinPointType two currently-separate ways in which we adjust the type of a join point. As the comment says: -- (adjustJoinPointType mult new_res_ty join_id) does two things: -- -- 1. Set the return type of the join_id to new_res_ty -- See Note [Return type for join points] -- -- 2. Adjust the multiplicity of arrows in join_id's type, as -- directed by 'mult'. See Note [Scaling join point arguments] I think this actually fixes a latent bug, by ensuring that the seIdSubst and seInScope have the right multiplicity on the type of join points. I did some tidying up while I was at it. No more setJoinResTy, or modifyJoinResTy: instead it's done locally in Simplify.Env.adjustJoinPointType - - - - - 49b265f0 by Chaitanya Koparkar at 2020-07-18T07:26:46-04:00 Fix minor typos in a Core.hs note - - - - - 8d59aed6 by Stefan Schulze Frielinghaus at 2020-07-18T07:26:47-04:00 GHCi: Fix isLittleEndian - - - - - c26e81d1 by Ben Gamari at 2020-07-18T07:26:47-04:00 testsuite: Mark ghci tests as fragile under unreg compiler In particular I have seen T16012 fail repeatedly under the unregisterised compiler. - - - - - 868e4523 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "AArch32 symbols only on aarch32." This reverts commit cdfeb3f24f76e8fd30452016676e56fbc827789a. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - c915ba84 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "Fix (1)" This reverts commit 7abffced01f5680efafe44f6be2733eab321b039. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 777c452a by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "better if guards." This reverts commit 3f60b94de1f460ca3f689152860b108a19ce193e. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 0dd40552 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "[linker/rtsSymbols] More linker symbols" This reverts commit 686e72253aed3880268dd6858eadd8c320f09e97. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 30caeee7 by Sylvain Henry at 2020-07-21T06:39:33-04:00 DynFlags: remove use of sdocWithDynFlags from GHC.Stg.* (#17957) * add StgPprOpts datatype * remove Outputable instances for types that need `StgPprOpts` to be pretty-printed and explicitly call type specific ppr functions * add default `panicStgPprOpts` for panic messages (when it's not convenient to thread StgPprOpts or DynFlags down to the ppr function call) - - - - - 863c544c by Mark at 2020-07-21T06:39:34-04:00 Fix a typo in existential_quantification.rst - - - - - 05910be1 by Krzysztof Gogolewski at 2020-07-21T14:47:07-04:00 Add release notes entry for #17816 [skip ci] - - - - - a6257192 by Matthew Pickering at 2020-07-21T14:47:19-04:00 Use a newtype `Code` for the return type of typed quotations (Proposal #195) There are three problems with the current API: 1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition of two type constructors. Doing so in your program involves making your own newtype and doing a lot of wrapping/unwrapping. For example, if I want to create a language which I can either run immediately or generate code from I could write the following with the new API. :: class Lang r where _int :: Int -> r Int _if :: r Bool -> r a -> r a -> r a instance Lang Identity where _int = Identity _if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f) instance Quote m => Lang (Code m) where _int = liftTyped _if cb ct cf = [|| if $$cb then $$ct else $$cf ||] 2. When doing code generation it is common to want to store code fragments in a map. When doing typed code generation, these code fragments contain a type index so it is desirable to store them in one of the parameterised map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from ``parameterized-utils``. :: compiler :: Env -> AST a -> Code Q a data AST a where ... data Ident a = ... type Env = MapF Ident (Code Q) newtype Code m a = Code (m (TExp a)) In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``. Using one of these map types currently requires creating your own newtype and constantly wrapping every quotation and unwrapping it when using a splice. Achievable, but it creates even more syntactic noise than normal metaprogramming. 3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is easier. This is a weak reason but one everyone can surely agree with. Updates text submodule. - - - - - 58235d46 by Ben Gamari at 2020-07-21T14:47:28-04:00 users-guide: Fix :rts-flag:`--copying-gc` documentation It was missing a newline. - - - - - 19e80b9a by Vladislav Zavialov at 2020-07-21T14:50:01-04:00 Accumulate Haddock comments in P (#17544, #17561, #8944) Haddock comments are, first and foremost, comments. It's very annoying to incorporate them into the grammar. We can take advantage of an important property: adding a Haddock comment does not change the parse tree in any way other than wrapping some nodes in HsDocTy and the like (and if it does, that's a bug). This patch implements the following: * Accumulate Haddock comments with their locations in the P monad. This is handled in the lexer. * After parsing, do a pass over the AST to associate Haddock comments with AST nodes using location info. * Report the leftover comments to the user as a warning (-Winvalid-haddock). - - - - - 4c719460 by David Binder at 2020-07-22T20:17:35-04:00 Fix dead link to haskell prime discussion - - - - - f2f817e4 by BinderDavid at 2020-07-22T20:17:35-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 0bf8980e by Daniel Gröber at 2020-07-22T20:18:11-04:00 Remove length field from FastString - - - - - 1010c33b by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 8336ba78 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - 7484a9a4 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 5536ed28 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 5b8902e3 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - 5976a161 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 9ddf1614 by Daniel Gröber at 2020-07-22T20:18:11-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - e9491668 by Ben Gamari at 2020-07-22T20:18:46-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 9f3ff8fd by Andreas Klebinger at 2020-07-22T20:19:22-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - 0f17b930 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - bab4ec8f by Sylvain Henry at 2020-07-22T20:19:59-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - 8ea33edb by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused sGhcWithNativeCodeGen - - - - - e079bb72 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - 735f9d6b by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - f7cc4313 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace HscTarget with Backend They both have the same role and Backend name is more explicit. Metric Decrease: T3064 Update Haddock submodule - - - - - 15ce1804 by Andreas Klebinger at 2020-07-22T20:20:34-04:00 Deprecate -fdmd-tx-dict-sel. It's behaviour is now unconditionally enabled as it's slightly beneficial. There are almost no benchmarks which benefit from disabling it, so it's not worth the keep this configurable. This fixes #18429. - - - - - ff1b7710 by Sylvain Henry at 2020-07-22T20:21:11-04:00 Add test for #18064 It has been fixed by 0effc57d48ace6b719a9f4cbeac67c95ad55010b - - - - - cfa89149 by Krzysztof Gogolewski at 2020-07-22T20:21:48-04:00 Define type Void# = (# #) (#18441) There's one backwards compatibility issue: GHC.Prim no longer exports Void#, we now manually re-export it from GHC.Exts. - - - - - 02f40b0d by Sebastian Graf at 2020-07-22T20:22:23-04:00 Add regression test for #18478 !3392 backported !2993 to GHC 8.10.2 which most probably is responsible for fixing #18478, which triggered a pattern match checker performance regression in GHC 8.10.1 as first observed in #17977. - - - - - 7f44df1e by Sylvain Henry at 2020-07-22T20:23:00-04:00 Minor refactoring of Unit display * for consistency, try to always use UnitPprInfo to display units to users * remove some uses of `unitPackageIdString` as it doesn't show the component name and it uses String - - - - - dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - cdd0ff16 by Tamar Christina at 2020-07-24T18:12:23-04:00 winio: restore console cp on exit - - - - - c1f4f81d by Tamar Christina at 2020-07-24T18:13:00-04:00 winio: change memory allocation strategy and fix double free errors. - - - - - ba205046 by Simon Peyton Jones at 2020-07-24T18:13:35-04:00 Care with occCheckExpand in kind of occurrences Issue #18451 showed that we could get an infinite type, through over-use of occCheckExpand in the kind of an /occurrence/ of a type variable. See Note [Occurrence checking: look inside kinds] in GHC.Core.Type This patch fixes the problem by making occCheckExpand less eager to expand synonyms in kinds. It also improves pretty printing of kinds, by *not* suppressing the kind on a tyvar-binder like (a :: Const Type b) where type Const p q = p. Even though the kind of 'a' is Type, we don't want to suppress the kind ascription. Example: the error message for polykinds/T18451{a,b}. See GHC.Core.TyCo.Ppr Note [Suppressing * kinds]. - - - - - 02133353 by Zubin Duggal at 2020-07-25T00:44:30-04:00 Simplify XRec definition Change `Located X` usage to `XRec pass X` This increases the scope of the LPat experiment to almost all of GHC. Introduce UnXRec and MapXRec classes Fixes #17587 and #18408 Updates haddock submodule Co-authored-by: Philipp Krüger <philipp.krueger1 at gmail.com> - - - - - e443846b by Sylvain Henry at 2020-07-25T00:45:07-04:00 DynFlags: store printer in TraceBinIfaceReading We don't need to pass the whole DynFlags, just pass the logging function, if any. - - - - - 15b2b44f by Sylvain Henry at 2020-07-25T00:45:08-04:00 Rename GHC.Driver.Ways into GHC.Platform.Ways - - - - - 342a01af by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add GHC.Platform.Profile - - - - - 6333d739 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Put PlatformConstants into Platform - - - - - 9dfeca6c by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove platform constant wrappers Platform constant wrappers took a DynFlags parameter, hence implicitly used the target platform constants. We removed them to allow support for several platforms at once (#14335) and to avoid having to pass the full DynFlags to every function (#17957). Metric Decrease: T4801 - - - - - 73145d57 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove dead code in utils/derivConstants - - - - - 7721b923 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Move GHC.Platform into the compiler Previously it was in ghc-boot so that ghc-pkg could use it. However it wasn't necessary because ghc-pkg only uses a subset of it: reading target arch and OS from the settings file. This is now done via GHC.Platform.ArchOS (was called PlatformMini before). - - - - - 459afeb5 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Fix build systems - - - - - 9e2930c3 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Bump CountParserDeps - - - - - 6e2db34b by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add accessors to ArchOS - - - - - fc0f6fbc by Stefan Schulze Frielinghaus at 2020-07-25T00:45:45-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 - - - - - a7c4439a by Matthias Andreas Benkard at 2020-07-26T13:23:24-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. - - - - - da7269a4 by Ben Gamari at 2020-07-26T13:23:59-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. - - - - - f153a1d0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Update win32 output for parseTree - - - - - e91672f0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. - - - - - 9cbfe086 by Ben Gamari at 2020-07-26T13:23:59-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. - - - - - 8236925f by Tamar Christina at 2020-07-26T13:24:35-04:00 winio: remove dead argument to stg_newIOPortzh - - - - - ce0a1d67 by Tamar Christina at 2020-07-26T13:25:11-04:00 winio: fix detection of tty terminals - - - - - 52685cf7 by Tamar Christina at 2020-07-26T13:25:48-04:00 winio: update codeowners - - - - - aee45d9e by Vladislav Zavialov at 2020-07-27T07:06:56-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. - - - - - 667ab69e by leiftw at 2020-07-27T07:07:32-04:00 fix typo referring to non-existent `-ohidir` flag, should be `-hidir` I think - - - - - 6ff89c17 by Vladislav Zavialov at 2020-07-27T07:08:07-04:00 Refactor the parser a little * Create a dedicated production for type operators * Create a dedicated type for the UNPACK pragma * Remove an outdated part of Note [Parsing data constructors is hard] - - - - - aa054d32 by Ben Gamari at 2020-07-27T20:09:07-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. - - - - - 6da73bbf by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Add minimal test for #12492 - - - - - 47680cb7 by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Use allocate, not ALLOC_PRIM_P for unpackClosure# ALLOC_PRIM_P fails for large closures, by directly using allocate we can handle closures which are larger than the block size. Fixes #12492 - - - - - 3d345c96 by Simon Peyton Jones at 2020-07-27T20:10:19-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 - - - - - 57aca6bb by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. - - - - - 0a815cea by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. - - - - - 0bd60059 by Simon Peyton Jones at 2020-07-28T02:01:49-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 - - - - - 6ee07b49 by Sylvain Henry at 2020-07-28T02:02:27-04:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - f305bbfd by Peter Trommler at 2020-07-28T02:03:02-04:00 config: Fix Haskell platform constructor w/ params Fixes #18505 - - - - - 318bb17c by Oleg Grenrus at 2020-07-28T20:54:13-04:00 Fix typo in haddock Spotted by `vilpan` on `#haskell` - - - - - 39c89862 by Sergei Trofimovich at 2020-07-28T20:54:50-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b9a880fc by Felix Wiemuth at 2020-07-29T15:06:35-04:00 Fix typo - - - - - c59064b0 by Brandon Chinn at 2020-07-29T15:07:11-04:00 Add regression test for #16341 - - - - - a61411ca by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass dit_rep_tc_args to dsm_stock_gen_fn - - - - - a26498da by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass tc_args to gen_fn - - - - - 44b11bad by Brandon Chinn at 2020-07-29T15:07:11-04:00 Filter out unreachable constructors when deriving stock instances (#16431) - - - - - bbc51916 by Simon Peyton Jones at 2020-07-29T15:07:47-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 - - - - - e3db4b4c by Peter Trommler at 2020-07-29T15:08:22-04:00 configure: Fix build system on ARM - - - - - 96c31ea1 by Sylvain Henry at 2020-07-29T15:09:02-04:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - e1dc3d7b by Krzysztof Gogolewski at 2020-07-29T15:09:39-04:00 Fix validation errors (#18510) Test T2632 is a stage1 test that failed because of the Q => Quote change. The remaining tests did not use quotation and failed when the path contained a space. - - - - - 6c68a842 by John Ericson at 2020-07-30T07:11:02-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. - - - - - 502de556 by cgibbard at 2020-07-30T07:11:02-04:00 Add haddock comment for unfilteredEdges and move the note about drop_hs_boot_nodes into it. - - - - - 01c948eb by Ryan Scott at 2020-07-30T07:11:37-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. - - - - - d47324ce by Ryan Scott at 2020-07-30T07:12:16-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. - - - - - ebe2cf45 by Simon Peyton Jones at 2020-07-30T07:12:52-04:00 Remove an incorrect WARN in extendLocalRdrEnv I noticed this warning going off, and discovered that it's really fine. This small patch removes the warning, and docments what is going on. - - - - - 9f71f697 by Simon Peyton Jones at 2020-07-30T07:13:27-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d - - - - - 7c274cd5 by Sylvain Henry at 2020-07-30T22:54:48-04:00 Fix minimal imports dump for boot files (fix #18497) - - - - - 175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00 DynFlags: don't use sdocWithDynFlags in datacon ppr We don't need to use `sdocWithDynFlags` to know whether we should display linear types for datacon types, we already have `sdocLinearTypes` field in `SDocContext`. Moreover we want to remove `sdocWithDynFlags` (#10143, #17957)). - - - - - 380638a3 by Sylvain Henry at 2020-07-30T22:56:03-04:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - 56a7c193 by Sylvain Henry at 2020-07-31T19:32:09+02:00 Refactor CLabel pretty-printing Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove (#10143, #17957). It uses it to query the backend and the platform. This patch exposes Clabel ppr functions specialised for each backend so that backend code can directly use them. - - - - - 3b15dc3c by Sylvain Henry at 2020-07-31T19:32:09+02:00 DynFlags: don't use sdocWithDynFlags in GHC.CmmToAsm.Dwarf.Types - - - - - e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00 Test case for #17652 The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec - - - - - 22641742 by Ryan Scott at 2020-08-02T16:44:11-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. - - - - - f2d1accf by Leon Schoorl at 2020-08-02T16:44:47-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 - - - - - 947206f4 by Niklas Hambüchen at 2020-08-03T07:52:33+02:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. - - - - - ef2ae81a by Alex Biehl at 2020-08-03T07:52:33+02:00 Hardcode RTS includes to cope with unregistered builds - - - - - d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 5e12cd17 by Krzysztof Gogolewski at 2020-08-05T04:00:04-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. - - - - - 2bff2f87 by Ben Gamari at 2020-08-05T04:00:39-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. - - - - - 53ce0db5 by Ben Gamari at 2020-08-05T04:00:39-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. - - - - - eb7013c3 by Hécate at 2020-08-05T04:01:15-04:00 Remove all the unnecessary LANGUAGE pragmas - - - - - fbcb886d by Ryan Scott at 2020-08-05T04:01:51-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. - - - - - 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - 21 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - .gitlab/test-metrics.sh - .gitmodules - CODEOWNERS - Makefile - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - + compiler/GHC/Builtin/RebindableNames.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af42e353970c300f932360dddde63c97b25591f8...b4edcde70160820dd23c53d9019f895930e2c0e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af42e353970c300f932360dddde63c97b25591f8...b4edcde70160820dd23c53d9019f895930e2c0e7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 03:57:59 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 01 Sep 2020 23:57:59 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] Apply suggestion to compiler/GHC/Driver/Pipeline.hs Message-ID: <5f4f1847e10_80b3f84866afbb81023184e@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: 558377cd by Moritz Angermann at 2020-09-01T23:57:57-04:00 Apply suggestion to compiler/GHC/Driver/Pipeline.hs - - - - - 1 changed file: - compiler/GHC/Driver/Pipeline.hs Changes: ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -401,7 +401,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- Since macOS Sierra (10.14), the dynamic system linker enforces -- a limit on the Load Commands. Specifically the Load Command Size -- Limit is at 32K (32768). The Load Commands contain the install --- name, dependencies, runpaths, and a few other commans. We however +-- name, dependencies, runpaths, and a few other commands. We however -- only have control over the install name, dependencies and runpaths. -- -- The install name is the name by which this library will be View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/558377cd74d92d27072f2203752a237154f2996a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/558377cd74d92d27072f2203752a237154f2996a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 03:58:03 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 01 Sep 2020 23:58:03 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] Apply suggestion to compiler/GHC/Driver/Pipeline.hs Message-ID: <5f4f184bf3088_80b3f8486992aec10232386@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: 3d66038f by Moritz Angermann at 2020-09-01T23:58:02-04:00 Apply suggestion to compiler/GHC/Driver/Pipeline.hs - - - - - 1 changed file: - compiler/GHC/Driver/Pipeline.hs Changes: ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -416,7 +416,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- directories to search for the referenced dependencies. -- -- The system linker can do recursive linking, however using only the --- direct dependencies conflicts with ghc ability to inline across +-- direct dependencies conflicts with ghc's ability to inline across -- packages, and as such would end up with unresolved symbols. -- -- Thus we will pass the full dependency closure to the linker, and then View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d66038f408a0f856cd5cdb8a7722fa2af62de66 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3d66038f408a0f856cd5cdb8a7722fa2af62de66 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 03:58:14 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 01 Sep 2020 23:58:14 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] Apply suggestion to compiler/GHC/Driver/Session.hs Message-ID: <5f4f185635923_80b3f848cdc774c1023284a@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: c383029e by Moritz Angermann at 2020-09-01T23:58:12-04:00 Apply suggestion to compiler/GHC/Driver/Session.hs - - - - - 1 changed file: - compiler/GHC/Driver/Session.hs Changes: ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -3842,7 +3842,7 @@ default_PIC platform = -- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS --- version the number of load commands we can embed in a dynamic library are +-- versions the number of load commands we can embed in a dynamic library is -- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only -- link the needed dylibs instead of linking the full dependency closure. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c383029e09c0d8638db6274932764a867d028647 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c383029e09c0d8638db6274932764a867d028647 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 03:58:29 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 01 Sep 2020 23:58:29 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] Apply suggestion to compiler/GHC/SysTools.hs Message-ID: <5f4f1865db529_80b3f848a2dd0cc102333c0@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: c3628361 by Moritz Angermann at 2020-09-01T23:58:28-04:00 Apply suggestion to compiler/GHC/SysTools.hs - - - - - 1 changed file: - compiler/GHC/SysTools.hs Changes: ===================================== compiler/GHC/SysTools.hs ===================================== @@ -389,7 +389,7 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_framework_opts -- dead_strip_dylibs, will remove unused dylibs, and thus save -- space in the load commands. The -headerpad is necessary so - -- that we can inject more @rpath's later for the left over + -- that we can inject more @rpath's later for the leftover -- libraries in the runInjectRpaths phase below. -- -- See Note [Dynamic linking on macOS] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c3628361e54804d165489e63ebf95dec5fda0b43 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c3628361e54804d165489e63ebf95dec5fda0b43 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 03:58:35 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 01 Sep 2020 23:58:35 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] Apply suggestion to compiler/GHC/SysTools/Tasks.hs Message-ID: <5f4f186b3f41f_80b3f8486992aec102338f4@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: 0d4e0aec by Moritz Angermann at 2020-09-01T23:58:34-04:00 Apply suggestion to compiler/GHC/SysTools/Tasks.hs - - - - - 1 changed file: - compiler/GHC/SysTools/Tasks.hs Changes: ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -248,7 +248,7 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do -- -- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing -- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not --- being included int he load commands, however the @-rpath@ entries are all +-- being included in the load commands, however the @-rpath@ entries are all -- forced to be included. This can lead to 100s of @-rpath@ entries being -- included when only a handful of liraries end up being turely linked. -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d4e0aecbbbdf9a8e5a6d80baa13c6973de7dff0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d4e0aecbbbdf9a8e5a6d80baa13c6973de7dff0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 03:58:40 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 01 Sep 2020 23:58:40 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] Apply suggestion to compiler/GHC/SysTools/Tasks.hs Message-ID: <5f4f1870d3022_80b3f848cdc774c1023435b@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: 9d8dd79a by Moritz Angermann at 2020-09-01T23:58:39-04:00 Apply suggestion to compiler/GHC/SysTools/Tasks.hs - - - - - 1 changed file: - compiler/GHC/SysTools/Tasks.hs Changes: ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -250,7 +250,7 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do -- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not -- being included in the load commands, however the @-rpath@ entries are all -- forced to be included. This can lead to 100s of @-rpath@ entries being --- included when only a handful of liraries end up being turely linked. +-- included when only a handful of libraries end up being turely linked. -- -- Thus after building the library, we run a fixup phase where we inject the -- @-rpath@ for each found library (in the given library search paths) into the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d8dd79ab1960837248b1ca7d5942d75a13b3e77 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d8dd79ab1960837248b1ca7d5942d75a13b3e77 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 03:58:48 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 01 Sep 2020 23:58:48 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] Apply suggestion to docs/users_guide/phases.rst Message-ID: <5f4f187881f01_80b3f848a2dd0cc1023488a@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: 51f661ad by Moritz Angermann at 2020-09-01T23:58:47-04:00 Apply suggestion to docs/users_guide/phases.rst - - - - - 1 changed file: - docs/users_guide/phases.rst Changes: ===================================== docs/users_guide/phases.rst ===================================== @@ -102,7 +102,7 @@ given compilation phase: Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and executables to read the dynamic library dependencies. We will compute - the necessary ``runpath``s to bembed for the dependencies based on the + the necessary ``runpath``s to embed for the dependencies based on the result of the ``otool`` call. .. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51f661ad06fdd471da1719aed9ed6f783b28b859 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/51f661ad06fdd471da1719aed9ed6f783b28b859 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 03:59:51 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 01 Sep 2020 23:59:51 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] Update Tasks.hs Message-ID: <5f4f18b7c24ae_80b8cbe02810235342@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: 57cfaa1f by Moritz Angermann at 2020-09-01T23:59:50-04:00 Update Tasks.hs - - - - - 1 changed file: - compiler/GHC/SysTools/Tasks.hs Changes: ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -250,7 +250,7 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do -- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not -- being included in the load commands, however the @-rpath@ entries are all -- forced to be included. This can lead to 100s of @-rpath@ entries being --- included when only a handful of libraries end up being turely linked. +-- included when only a handful of libraries end up being truely linked. -- -- Thus after building the library, we run a fixup phase where we inject the -- @-rpath@ for each found library (in the given library search paths) into the View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57cfaa1f8cb6c5b383671bfa131c0ba01b8efe1b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57cfaa1f8cb6c5b383671bfa131c0ba01b8efe1b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 13:22:00 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Wed, 02 Sep 2020 09:22:00 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] [macOS] improved runpath handling Message-ID: <5f4f9c78de491_80b3f848693993810258180@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: 65b73d9f by Moritz Angermann at 2020-09-02T21:21:13+08:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - 15 changed files: - aclocal.m4 - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - docs/users_guide/phases.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - mk/config.mk.in Changes: ===================================== aclocal.m4 ===================================== @@ -579,6 +579,18 @@ AC_DEFUN([FP_SETTINGS], else SettingsOptCommand="$OptCmd" fi + if test -z "$OtoolCmd" + then + SettingsOtoolCommand="otool" + else + SettingsOtoolCommand="$OtoolCmd" + fi + if test -z "$InstallNameToolCmd" + then + SettingsInstallNameToolCommand="install_name_tool" + else + SettingsInstallNameToolCommand="$InstallNameToolCmd" + fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -596,6 +608,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -394,7 +394,56 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commands. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc's ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1787,9 +1836,12 @@ linkBinary' staticLink dflags o_files dep_units = do rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then GHC.SysTools.runLibtool - else GHC.SysTools.runLink + let link dflags args | staticLink = GHC.SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = GHC.SysTools.runLink dflags args >> GHC.SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = GHC.SysTools.runLink dflags args + link dflags ( map GHC.SysTools.Option verbFlags ++ [ GHC.SysTools.Option "-o" @@ -1856,7 +1908,13 @@ linkBinary' staticLink dflags o_files dep_units = do ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -145,8 +145,8 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, + pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool, + pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -885,6 +885,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags +pgm_otool :: DynFlags -> String +pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) @@ -2267,6 +2271,10 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } + , make_ord_flag defFlag "pgmotool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f} + , make_ord_flag defFlag "pgminstall_name_tool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f} , make_ord_flag defFlag "pgmranlib" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } @@ -3780,7 +3788,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -3791,6 +3798,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -3831,6 +3840,29 @@ default_PIC platform = -- information. _ -> [] + +-- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS +-- versions the number of load commands we can embed in a dynamic library is +-- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only +-- link the needed dylibs instead of linking the full dependency closure. +-- +-- If we split the library linking into injecting -rpath and -l @rpath/... +-- components, we will reduce the number of libraries we link, however we will +-- still inject one -rpath entry for each library, independent of their use. +-- That is, we even inject -rpath values for libraries that we dead_strip in +-- the end. As such we can run afoul of the load command size limit simply +-- by polluting the load commands with RPATH entries. +-- +-- Thus, we disable Opt_RPath by default on OSDarwin. The savvy user can always +-- enable it with -use-rpath if they so wish. +-- +-- See Note [Dynamic linking on macOS] + +default_RPath :: Platform -> [GeneralFlag] +default_RPath platform | platformOS platform == OSDarwin = [] +default_RPath _ = [Opt_RPath] + + -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -929,20 +929,22 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,6 +34,8 @@ module GHC.Settings , sPgm_windres , sPgm_libtool , sPgm_ar + , sPgm_otool + , sPgm_install_name_tool , sPgm_ranlib , sPgm_lo , sPgm_lc @@ -107,6 +109,8 @@ data ToolSettings = ToolSettings , toolSettings_pgm_windres :: String , toolSettings_pgm_libtool :: String , toolSettings_pgm_ar :: String + , toolSettings_pgm_otool :: String + , toolSettings_pgm_install_name_tool :: String , toolSettings_pgm_ranlib :: String , -- | LLVM: opt llvm optimiser toolSettings_pgm_lo :: (String, [Option]) @@ -216,6 +220,10 @@ sPgm_libtool :: Settings -> String sPgm_libtool = toolSettings_pgm_libtool . sToolSettings sPgm_ar :: Settings -> String sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_otool :: Settings -> String +sPgm_otool = toolSettings_pgm_otool . sToolSettings +sPgm_install_name_tool :: Settings -> String +sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings sPgm_ranlib :: Settings -> String sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings sPgm_lo :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -115,6 +115,8 @@ initSettings top_dir = do windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -191,6 +193,8 @@ initSettings top_dir = do , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) ===================================== compiler/GHC/SysTools.hs ===================================== @@ -259,7 +259,10 @@ linkDynLib dflags0 o_files dep_packages | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `Set.member` ways dflags + -- Only if we want dynamic libraries + WayDyn `Set.member` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -384,8 +387,15 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the leftover + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -28,6 +28,10 @@ import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pa import GHC.SysTools.Process import GHC.SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,39 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included in the load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of libraries end up being truely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath at . +-- +-- See Note: [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + -- find any pre-existing LC_PATH items + info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib] + let paths = fmap (\(_:p:_) -> p) $ filter (\x -> head x == "path") $ info + lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ] + -- only find those rpaths, that aren't already in the library. + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths') + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -329,6 +366,17 @@ runAr dflags cwd args = traceToolCommand dflags "ar" $ do let ar = pgm_ar dflags runSomethingFiltered dflags id "Ar" ar args cwd Nothing +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing + runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do let ranlib = pgm_ranlib dflags ===================================== configure.ac ===================================== @@ -697,6 +697,18 @@ else fi AC_SUBST([LibtoolCmd]) +dnl ** Which otool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([OTOOL], [otool]) +OtoolCmd="$OTOOL" +AC_SUBST(OtoolCmd) + +dnl ** Which install_name_tool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool]) +InstallNameToolCmd="$INSTALL_NAME_TOOL" +AC_SUBST(InstallNameToolCmd) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -1520,6 +1532,8 @@ echo "\ libtool : $LibtoolCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd + otool : $OtoolCmd + install_name_tool : $InstallNameToolCmd windres : $WindresCmd dllwrap : $DllWrapCmd genlib : $GenlibCmd ===================================== docs/users_guide/phases.rst ===================================== @@ -95,6 +95,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only). +.. ghc-flag:: -pgmotool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inspect mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and + executables to read the dynamic library dependencies. We will compute + the necessary ``runpath``s to embed for the dependencies based on the + result of the ``otool`` call. + +.. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inject ``runpath`` into mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inject ``runpath``s into mach-o dynamic + libraries and executables. As detected by the ``otool`` call. + .. ghc-flag:: -pgmwindres ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the program for embedding manifests on Windows. :type: dynamic ===================================== hadrian/cfg/system.config.in ===================================== @@ -151,6 +151,8 @@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ +settings-otool-command = @SettingsOtoolCommand@ +settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-libtool-command = @SettingsLibtoolCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -114,6 +114,8 @@ data SettingsFileSetting | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_OtoolCommand + | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_LibtoolCommand @@ -200,6 +202,8 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_OtoolCommand -> "settings-otool-command" + SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -308,6 +308,8 @@ generateSettings = do , ("ar flags", expr $ lookupValueOrError configFile "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) ===================================== includes/ghc.mk ===================================== @@ -233,6 +233,8 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ + @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -504,6 +504,8 @@ SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65b73d9f432564624748e28c6259055d7466e210 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/65b73d9f432564624748e28c6259055d7466e210 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 14:39:05 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 02 Sep 2020 10:39:05 -0400 Subject: [Git][ghc/ghc][wip/happy-1.20] 23 commits: Consolidate imports in getMinimalImports (#18264) Message-ID: <5f4fae892466_80b3f849c1df07810262829@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/happy-1.20 at Glasgow Haskell Compiler / GHC Commits: 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - 7af16e62 by Vladislav Zavialov at 2020-09-02T17:38:14+03:00 Require happy >=1.20 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Debug.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/SysTools/BaseDir.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86ac4dbff79443509c2acfdefd59d562c48335e7...7af16e625175e3227c2317cb53aa0cb51006a955 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86ac4dbff79443509c2acfdefd59d562c48335e7...7af16e625175e3227c2317cb53aa0cb51006a955 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 14:43:51 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Wed, 02 Sep 2020 10:43:51 -0400 Subject: [Git][ghc/ghc][wip/parsing-shift] 24 commits: Consolidate imports in getMinimalImports (#18264) Message-ID: <5f4fafa7b7f76_80bd4f923410263426@gitlab.haskell.org.mail> Vladislav Zavialov pushed to branch wip/parsing-shift at Glasgow Haskell Compiler / GHC Commits: 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - 7af16e62 by Vladislav Zavialov at 2020-09-02T17:38:14+03:00 Require happy >=1.20 - - - - - d6f9b4fe by Vladislav Zavialov at 2020-09-02T17:43:37+03:00 Resolve shift/reduce conflicts with %shift (#17232) - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Debug.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Parser.y - compiler/GHC/Rename/Names.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b657eb9d6b67d36ff7e185c8782ffd9bfef13409...d6f9b4fece701752dcab1ecc0599fedd35817a74 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b657eb9d6b67d36ff7e185c8782ffd9bfef13409...d6f9b4fece701752dcab1ecc0599fedd35817a74 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 14:54:26 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 02 Sep 2020 10:54:26 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Fix FastString lexicographic ordering (fix #18562) Message-ID: <5f4fb22267a2f_80b1146cd941027272a@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - ecbb4ca2 by Sebastian Graf at 2020-09-02T10:54:10-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - 4b83ba70 by David Feuer at 2020-09-02T10:54:12-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - 30ee2283 by Sylvain Henry at 2020-09-02T10:54:15-04:00 Remove outdated note - - - - - ab44b2ab by Sylvain Henry at 2020-09-02T10:54:17-04:00 Bignum: add missing compat import/export functions - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Debug.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/SysTools.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Types/CostCentre.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Types/Name/Occurrence.hs - compiler/GHC/Types/SrcLoc.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f81b58d9dd4f7999ade954eb95c6fcf680b50a7...ab44b2abcbbf85c681f0e578b6dffe20efbe2e98 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f81b58d9dd4f7999ade954eb95c6fcf680b50a7...ab44b2abcbbf85c681f0e578b6dffe20efbe2e98 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 16:48:05 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 02 Sep 2020 12:48:05 -0400 Subject: [Git][ghc/ghc][wip/T14422] PmCheck: Disattach COMPLETE pragmas from TyCons Message-ID: <5f4fccc5b5a3c_80b3f84a4068818102898ee@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14422 at Glasgow Haskell Compiler / GHC Commits: db173247 by Sebastian Graf at 2020-09-02T18:46:23+02:00 PmCheck: Disattach COMPLETE pragmas from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and, most prominently, #14422. - - - - - 23 changed files: - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/IfaceToCore.hs-boot - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Types/Unique/DFM.hs - docs/users_guide/exts/pragmas.rst - testsuite/tests/pmcheck/complete_sigs/completesig15.hs → testsuite/tests/pmcheck/complete_sigs/T14422.hs - + testsuite/tests/pmcheck/complete_sigs/T18277.hs - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/complete_sigs/completesig04.hs - testsuite/tests/pmcheck/complete_sigs/completesig04.stderr - − testsuite/tests/pmcheck/complete_sigs/completesig15.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Driver.Types ( lookupIfaceByModule, emptyPartialModIface, emptyFullModIface, lookupHptByModule, PackageInstEnv, PackageFamInstEnv, PackageRuleBase, - PackageCompleteMatchMap, + PackageCompleteMatches, mkSOName, mkHsSOName, soExt, @@ -146,8 +146,7 @@ module GHC.Driver.Types ( handleFlagWarnings, printOrThrowWarnings, -- * COMPLETE signature - CompleteMatch(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap, + ConLikeSet, CompleteMatch, CompleteMatches, -- * Exstensible Iface fields ExtensibleFields(..), FieldName, @@ -734,7 +733,7 @@ lookupIfaceByModule hpt pit mod -- of its own, but it doesn't seem worth the bother. hptCompleteSigs :: HscEnv -> [CompleteMatch] -hptCompleteSigs = hptAllThings (md_complete_sigs . hm_details) +hptCompleteSigs = hptAllThings (md_complete_matches . hm_details) -- | Find all the instance declarations (of classes and families) from -- the Home Package Table filtered by the provided predicate function. @@ -1092,7 +1091,7 @@ data ModIface_ (phase :: ModIfacePhase) -- itself) but imports some trustworthy modules from its own -- package (which does require its own package be trusted). -- See Note [Trust Own Package] in GHC.Rename.Names - mi_complete_sigs :: [IfaceCompleteMatch], + mi_complete_matches :: [IfaceCompleteMatch], mi_doc_hdr :: Maybe HsDocString, -- ^ Module header. @@ -1183,7 +1182,7 @@ instance Binary ModIface where mi_hpc = hpc_info, mi_trust = trust, mi_trust_pkg = trust_pkg, - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1229,7 +1228,7 @@ instance Binary ModIface where put_ bh hpc_info put_ bh trust put_ bh trust_pkg - put_ bh complete_sigs + put_ bh complete_matches lazyPut bh doc_hdr lazyPut bh decl_docs lazyPut bh arg_docs @@ -1262,7 +1261,7 @@ instance Binary ModIface where hpc_info <- get bh trust <- get bh trust_pkg <- get bh - complete_sigs <- get bh + complete_matches <- get bh doc_hdr <- lazyGet bh decl_docs <- lazyGet bh arg_docs <- lazyGet bh @@ -1286,7 +1285,7 @@ instance Binary ModIface where mi_trust = trust, mi_trust_pkg = trust_pkg, -- And build the cached values - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1331,7 +1330,7 @@ emptyPartialModIface mod mi_hpc = False, mi_trust = noIfaceTrustInfo, mi_trust_pkg = False, - mi_complete_sigs = [], + mi_complete_matches = [], mi_doc_hdr = Nothing, mi_decl_docs = emptyDeclDocMap, mi_arg_docs = emptyArgDocMap, @@ -1387,7 +1386,7 @@ data ModDetails md_rules :: ![CoreRule], -- ^ Domain may include 'Id's from other modules md_anns :: ![Annotation], -- ^ Annotations present in this module: currently -- they only annotate things also declared in this module - md_complete_sigs :: [CompleteMatch] + md_complete_matches :: [CompleteMatch] -- ^ Complete match pragmas for this module } @@ -1400,7 +1399,7 @@ emptyModDetails md_rules = [], md_fam_insts = [], md_anns = [], - md_complete_sigs = [] } + md_complete_matches = [] } -- | Records the modules directly imported by a module for extracting e.g. -- usage information, and also to give better error message @@ -1463,7 +1462,7 @@ data ModGuts -- ^ Files to be compiled with the C compiler mg_warns :: !Warnings, -- ^ Warnings declared in the module mg_anns :: [Annotation], -- ^ Annotations declared in this module - mg_complete_sigs :: [CompleteMatch], -- ^ Complete Matches + mg_complete_matches :: [CompleteMatch], -- ^ Complete Matches mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module @@ -2684,7 +2683,7 @@ type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv type PackageAnnEnv = AnnEnv -type PackageCompleteMatchMap = CompleteMatchMap +type PackageCompleteMatches = CompleteMatches -- | Information about other packages that we have slurped in by reading -- their interface files @@ -2746,8 +2745,8 @@ data ExternalPackageState -- from all the external-package modules eps_ann_env :: !PackageAnnEnv, -- ^ The total 'AnnEnv' accumulated -- from all the external-package modules - eps_complete_matches :: !PackageCompleteMatchMap, - -- ^ The total 'CompleteMatchMap' accumulated + eps_complete_matches :: !PackageCompleteMatches, + -- ^ The total 'CompleteMatches' accumulated -- from all the external-package modules eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external @@ -3203,36 +3202,13 @@ byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) ------------------------------------------- +type ConLikeSet = UniqDSet ConLike + -- | A list of conlikes which represents a complete pattern match. -- These arise from @COMPLETE@ signatures. +type CompleteMatch = ConLikeSet --- See Note [Implementation of COMPLETE signatures] -data CompleteMatch = CompleteMatch { - completeMatchConLikes :: [Name] - -- ^ The ConLikes that form a covering family - -- (e.g. Nothing, Just) - , completeMatchTyCon :: Name - -- ^ The TyCon that they cover (e.g. Maybe) - } - -instance Outputable CompleteMatch where - ppr (CompleteMatch cl ty) = text "CompleteMatch:" <+> ppr cl - <+> dcolon <+> ppr ty - --- | A map keyed by the 'completeMatchTyCon' which has type Name. - --- See Note [Implementation of COMPLETE signatures] -type CompleteMatchMap = UniqFM Name [CompleteMatch] - -mkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap -mkCompleteMatchMap = extendCompleteMatchMap emptyUFM - -extendCompleteMatchMap :: CompleteMatchMap -> [CompleteMatch] - -> CompleteMatchMap -extendCompleteMatchMap = foldl' insertMatch - where - insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap - insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c] +type CompleteMatches = [CompleteMatch] {- Note [Implementation of COMPLETE signatures] @@ -3252,33 +3228,14 @@ function, it gives rise to a total function. An example is: booleanToInt F = 0 booleanToInt T = 1 -COMPLETE sets are represented internally in GHC with the CompleteMatch data -type. For example, {-# COMPLETE F, T #-} would be represented as: - - CompleteMatch { complateMatchConLikes = [F, T] - , completeMatchTyCon = Boolean } - -Note that GHC was able to infer the completeMatchTyCon (Boolean), but for the -cases in which it's ambiguous, you can also explicitly specify it in the source -language by writing this: - - {-# COMPLETE F, T :: Boolean #-} - -For efficiency purposes, GHC collects all of the CompleteMatches that it knows -about into a CompleteMatchMap, which is a map that is keyed by the -completeMatchTyCon. In other words, you could have a multiple COMPLETE sets -for the same TyCon: - - {-# COMPLETE F, T1 :: Boolean #-} - {-# COMPLETE F, T2 :: Boolean #-} +COMPLETE sets are represented internally in GHC a set of 'ConLike's. For +example, {-# COMPLETE F, T #-} would be represented as: -And looking up the values in the CompleteMatchMap associated with Boolean -would give you [CompleteMatch [F, T1] Boolean, CompleteMatch [F, T2] Boolean]. -dsGetCompleteMatches in GHC.HsToCore.Quote accomplishes this lookup. + {F, T} -Also see Note [Typechecking Complete Matches] in GHC.Tc.Gen.Bind for a more detailed -explanation for how GHC ensures that all the conlikes in a COMPLETE set are -consistent. +GHC collects all COMPLETE pragmas from the current module and from imports +into a field in the DsM environment, which can be accessed with +dsGetCompleteMatches from "GHC.HsToCore.Monad". -} -- | Foreign language of the phase if the phase deals with a foreign code ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -224,7 +224,7 @@ deSugar hsc_env mg_modBreaks = modBreaks, mg_safe_haskell = safe_mode, mg_trust_pkg = imp_trust_own_pkg imports, - mg_complete_sigs = complete_matches, + mg_complete_matches = complete_matches, mg_doc_hdr = doc_hdr, mg_decl_docs = decl_docs, mg_arg_docs = arg_docs ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -88,7 +88,6 @@ import GHC.Driver.Ppr import GHC.Utils.Error import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Types.Unique.FM ( lookupWithDefaultUFM_Directly ) import GHC.Types.Literal ( mkLitString ) import GHC.Types.CostCentre.State @@ -210,13 +209,15 @@ mkDsEnvsFromTcGbl :: MonadIO m -> m (DsGblEnv, DsLclEnv) mkDsEnvsFromTcGbl hsc_env msg_var tcg_env = do { cc_st_var <- liftIO $ newIORef newCostCentreState + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env this_mod = tcg_mod tcg_env type_env = tcg_type_env tcg_env rdr_env = tcg_rdr_env tcg_env fam_inst_env = tcg_fam_inst_env tcg_env - complete_matches = hptCompleteSigs hsc_env - ++ tcg_complete_matches tcg_env + !complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ tcg_complete_matches tcg_env -- from the current module + ++ eps_complete_matches eps -- from imports ; return $ mkDsEnvs dflags this_mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches } @@ -239,13 +240,15 @@ initDsWithModGuts :: HscEnv -> ModGuts -> DsM a -> IO (Messages, Maybe a) initDsWithModGuts hsc_env guts thing_inside = do { cc_st_var <- newIORef newCostCentreState ; msg_var <- newIORef emptyMessages + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts) rdr_env = mg_rdr_env guts fam_inst_env = mg_fam_inst_env guts this_mod = mg_module guts - complete_matches = hptCompleteSigs hsc_env - ++ mg_complete_sigs guts + !complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ mg_complete_matches guts -- from the current module + ++ eps_complete_matches eps -- from imports bindsToIds (NonRec v _) = [v] bindsToIds (Rec binds) = map fst binds @@ -281,7 +284,7 @@ initTcDsForSolver thing_inside thing_inside } mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv - -> IORef Messages -> IORef CostCentreState -> [CompleteMatch] + -> IORef Messages -> IORef CostCentreState -> CompleteMatches -> (DsGblEnv, DsLclEnv) mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches @@ -290,7 +293,6 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod) NotBoot real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1) - completeMatchMap = mkCompleteMatchMap complete_matches gbl_env = DsGblEnv { ds_mod = mod , ds_fam_inst_env = fam_inst_env , ds_if_env = (if_genv, if_lenv) @@ -299,7 +301,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var (mkHomeUnitFromFlags dflags) rdr_env , ds_msgs = msg_var - , ds_complete_matches = completeMatchMap + , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv @@ -533,18 +535,9 @@ dsGetFamInstEnvs dsGetMetaEnv :: DsM (NameEnv DsMetaVal) dsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) } --- | The @COMPLETE@ pragmas provided by the user for a given `TyCon`. -dsGetCompleteMatches :: TyCon -> DsM [CompleteMatch] -dsGetCompleteMatches tc = do - eps <- getEps - env <- getGblEnv - -- We index into a UniqFM from Name -> elt, for tyCon it holds that - -- getUnique (tyConName tc) == getUnique tc. So we lookup using the - -- unique directly instead. - let lookup_completes ufm = lookupWithDefaultUFM_Directly ufm [] (getUnique tc) - eps_matches_list = lookup_completes $ eps_complete_matches eps - env_matches_list = lookup_completes $ ds_complete_matches env - return $ eps_matches_list ++ env_matches_list +-- | The @COMPLETE@ pragmas that are in scope. +dsGetCompleteMatches :: DsM CompleteMatches +dsGetCompleteMatches = ds_complete_matches <$> getGblEnv dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal) dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (dsl_meta env) name) } ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -66,13 +66,13 @@ import GHC.Core.TyCo.Rep import GHC.Core.Type import GHC.Tc.Solver (tcNormalise, tcCheckSatisfiability) import GHC.Core.Unify (tcMatchTy) -import GHC.Tc.Types (completeMatchConLikes) import GHC.Core.Coercion import GHC.Utils.Monad hiding (foldlM) import GHC.HsToCore.Monad hiding (foldlM) import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv +import Control.Applicative ((<|>)) import Control.Monad (guard, mzero, when) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict @@ -80,7 +80,6 @@ import Data.Bifunctor (second) import Data.Either (partitionEithers) import Data.Foldable (foldlM, minimumBy, toList) import Data.List (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ord (comparing) import qualified Data.Semigroup as Semigroup import Data.Tuple (swap) @@ -105,11 +104,54 @@ mkPmId ty = getUniqueM >>= \unique -> ----------------------------------------------- -- * Caching possible matches of a COMPLETE set -markMatched :: ConLike -> PossibleMatches -> PossibleMatches -markMatched _ NoPM = NoPM -markMatched con (PM ms) = PM (del_one_con con <$> ms) +-- | Traverse the COMPLETE sets of 'ResidualCompleteMatches'. +trvRcm :: Applicative f => (ConLikeSet -> f ConLikeSet) -> ResidualCompleteMatches -> f ResidualCompleteMatches +trvRcm f (RCM vanilla pragmas) = RCM <$> traverse f vanilla + <*> traverse (traverse f) pragmas +-- | Update the COMPLETE sets of 'ResidualCompleteMatches'. +updRcm :: (ConLikeSet -> ConLikeSet) -> ResidualCompleteMatches -> ResidualCompleteMatches +updRcm f (RCM vanilla pragmas) = RCM (f <$> vanilla) (fmap f <$> pragmas) + +-- | A pseudo-'CompleteMatch' for the vanilla complete set of the given data +-- 'TyCon'. +-- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ +vanillaCompleteMatchTC :: TyCon -> Maybe ConLikeSet +vanillaCompleteMatchTC tc = + let -- | TYPE acts like an empty data type on the term-level (#14086), but + -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a + -- special case. + mb_dcs | tc == tYPETyCon = Just [] + | otherwise = tyConDataCons_maybe tc + in mkUniqDSet . map RealDataCon <$> mb_dcs + +-- | Initialise from 'dsGetCompleteMatches' (containing all COMPLETE pragmas) +-- if the given 'ResidualCompleteMatches' were empty. +addCompleteMatches :: ResidualCompleteMatches -> DsM ResidualCompleteMatches +addCompleteMatches (RCM v Nothing) = RCM v . Just <$> dsGetCompleteMatches +addCompleteMatches rcm = pure rcm + +-- | Adds the declared 'CompleteMatches' from COMPLETE pragmas, as well as the +-- vanilla data defn if it is a 'DataCon'. +addConLikeMatches :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addConLikeMatches (RealDataCon dc) rcm = addTyConMatches (dataConTyCon dc) rcm +addConLikeMatches (PatSynCon _) rcm = addCompleteMatches rcm + +-- | Adds +-- * the 'CompleteMatches' from COMPLETE pragmas +-- * and the /vanilla/ 'CompleteMatch' from the data 'TyCon' +-- to the 'ResidualCompleteMatches', if not already present. +addTyConMatches :: TyCon -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addTyConMatches tc rcm = add_tc_match <$> addCompleteMatches rcm where - del_one_con = flip delOneFromUniqDSet + -- | Add the vanilla COMPLETE set from the data defn, if any. But only if + -- it's not already present. + add_tc_match rcm + = rcm{rcm_vanilla = rcm_vanilla rcm <|> vanillaCompleteMatchTC tc} + +markMatched :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +markMatched cl rcm = do + rcm' <- addConLikeMatches cl rcm + pure $ updRcm (flip delOneFromUniqDSet cl) rcm' --------------------------------------------------- -- * Instantiating constructors, types and evidence @@ -492,7 +534,7 @@ tyOracle (TySt inert) cts -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. Doesn't bother calling out to the type oracle if the bag of new type --- constraints was empty. Will only recheck 'PossibleMatches' in the term oracle +-- constraints was empty. Will only recheck 'ResidualCompleteMatches' in the term oracle -- for emptiness if the first argument is 'True'. tyIsSatisfiable :: Bool -> Bag PredType -> SatisfiabilityCheck tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \nabla -> @@ -544,10 +586,10 @@ of a PatSynCon (Just42,[]), this solution is incomparable to both Nothing and Just. Hence we retain the info in vi_neg, which eventually allows us to detect the complete pattern match. -The Pos/Neg invariant extends to vi_cache, which stores essentially positive -information. We make sure that vi_neg and vi_cache never overlap. This isn't -strictly necessary since vi_cache is just a cache, so doesn't need to be -accurate: Every suggestion of a possible ConLike from vi_cache might be +The Pos/Neg invariant extends to vi_rcm, which stores essentially positive +information. We make sure that vi_neg and vi_rcm never overlap. This isn't +strictly necessary since vi_rcm is just a cache, so doesn't need to be +accurate: Every suggestion of a possible ConLike from vi_rcm might be refutable by the type oracle anyway. But it helps to maintain sanity while debugging traces. @@ -568,7 +610,7 @@ The term oracle state is never obviously (i.e., without consulting the type oracle) contradictory. This implies a few invariants: * Whenever vi_pos overlaps with vi_neg according to 'eqPmAltCon', we refute. This is implied by the Note [Pos/Neg invariant]. -* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_cache to +* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_rcm to detect this, but we could just compare whole COMPLETE sets to vi_neg every time, if it weren't for performance. @@ -624,13 +666,16 @@ tmIsSatisfiable new_tm_cs = SC $ \nabla -> runMaybeT $ foldlM addTmCt nabla new_ ----------------------- -- * Looking up VarInfo +emptyRCM :: ResidualCompleteMatches +emptyRCM = RCM Nothing Nothing + emptyVarInfo :: Id -> VarInfo -- We could initialise @bot@ to @Just False@ in case of an unlifted type here, -- but it's cleaner to let the user of the constraint solver take care of this. -- After all, there are also strict fields, the unliftedness of which isn't -- evident in the type. So treating unlifted types here would never be -- sufficient anyway. -emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot NoPM +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot emptyRCM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' @@ -656,85 +701,6 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of | isNewDataCon dc = Just y go _ = Nothing -initPossibleMatches :: TyState -> VarInfo -> DsM VarInfo -initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do - -- New evidence might lead to refined info on ty, in turn leading to discovery - -- of a COMPLETE set. - res <- pmTopNormaliseType ty_st ty - let ty' = normalisedSourceType res - case splitTyConApp_maybe ty' of - Nothing -> pure vi{ vi_ty = ty' } - Just (tc, [_]) - | tc == tYPETyCon - -- TYPE acts like an empty data type on the term-level (#14086), but - -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a - -- special case. - -> pure vi{ vi_ty = ty', vi_cache = PM (pure emptyUniqDSet) } - Just (tc, tc_args) -> do - -- See Note [COMPLETE sets on data families] - (tc_rep, tc_fam) <- case tyConFamInst_maybe tc of - Just (tc_fam, _) -> pure (tc, tc_fam) - Nothing -> do - env <- dsGetFamInstEnvs - let (tc_rep, _tc_rep_args, _co) = tcLookupDataFamInst env tc tc_args - pure (tc_rep, tc) - -- Note that the common case here is tc_rep == tc_fam - let mb_rdcs = map RealDataCon <$> tyConDataCons_maybe tc_rep - let rdcs = maybeToList mb_rdcs - -- NB: tc_fam, because COMPLETE sets are associated with the parent data - -- family TyCon - pragmas <- dsGetCompleteMatches tc_fam - let fams = mapM dsLookupConLike . completeMatchConLikes - pscs <- mapM fams pragmas - -- pprTrace "initPossibleMatches" (ppr ty $$ ppr ty' $$ ppr tc_rep <+> ppr tc_fam <+> ppr tc_args $$ ppr (rdcs ++ pscs)) (return ()) - case NonEmpty.nonEmpty (rdcs ++ pscs) of - Nothing -> pure vi{ vi_ty = ty' } -- Didn't find any COMPLETE sets - Just cs -> pure vi{ vi_ty = ty', vi_cache = PM (mkUniqDSet <$> cs) } -initPossibleMatches _ vi = pure vi - -{- Note [COMPLETE sets on data families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -User-defined COMPLETE sets involving data families are attached to the family -TyCon, whereas the built-in COMPLETE set is attached to a data family instance's -representation TyCon. This matters for COMPLETE sets involving both DataCons -and PatSyns (from #17207): - - data family T a - data family instance T () = A | B - pattern C = B - {-# COMPLETE A, C #-} - f :: T () -> () - f A = () - f C = () - -The match on A is actually wrapped in a CoPat, matching impedance between T () -and its representation TyCon, which we translate as - at x | let y = x |> co, A <- y@ in PmCheck. - -Which TyCon should we use for looking up the COMPLETE set? The representation -TyCon from the match on A would only reveal the built-in COMPLETE set, while the -data family TyCon would only give the user-defined one. But when initialising -the PossibleMatches for a given Type, we want to do so only once, because -merging different COMPLETE sets after the fact is very complicated and possibly -inefficient. - -So in fact, we just *drop* the coercion arising from the CoPat when handling -handling the constraint @y ~ x |> co@ in addCoreCt, just equating @y ~ x at . -We then handle the fallout in initPossibleMatches, which has to get a hand at -both the representation TyCon tc_rep and the parent data family TyCon tc_fam. -It considers three cases after having established that the Type is a TyConApp: - -1. The TyCon is a vanilla data type constructor -2. The TyCon is tc_rep -3. The TyCon is tc_fam - -1. is simple and subsumed by the handling of the other two. -We check for case 2. by 'tyConFamInst_maybe' and get the tc_fam out. -Otherwise (3.), we try to lookup the data family instance at that particular -type to get out the tc_rep. In case 1., this will just return the original -TyCon, so tc_rep = tc_fam afterwards. --} - ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -897,11 +863,7 @@ addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do - -- For good performance, it's important to initPossibleMatches here. - -- Otherwise we can't mark nalt as matched later on, incurring unnecessary - -- inhabitation tests for nalt. - vi@(VI _ pos neg _ pm) <- lift $ initPossibleMatches (nabla_ty_st nabla) - (lookupVarInfo ts x) + let vi@(VI _ pos neg _ rcm) = lookupVarInfo ts x -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt (cl, _tvs, _args) = eqPmAltCon cl nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -917,9 +879,11 @@ addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor vi2 <- case nalt of - PmAltConLike cl - -> ensureInhabited nabla vi1{ vi_cache = markMatched cl pm } - _ -> pure vi1 + PmAltConLike cl -> do + rcm' <- lift (markMatched cl rcm) + ensureInhabited nabla vi1{ vi_rcm = rcm' } + _ -> + pure vi1 pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } hasRequiredTheta :: PmAltCon -> Bool @@ -963,13 +927,15 @@ storing required arguments along with the PmAltConLike in 'vi_neg'. -- its result type. Rather easy for DataCons, but not so much for PatSynCons. -- See Note [Pattern synonym result type] in "GHC.Core.PatSyn". guessConLikeUnivTyArgsFromResTy :: FamInstEnvs -> Type -> ConLike -> Maybe [Type] -guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon _) = do +guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon dc) = do (tc, tc_args) <- splitTyConApp_maybe res_ty -- Consider data families: In case of a DataCon, we need to translate to -- the representation TyCon. For PatSyns, they are relative to the data -- family TyCon, so we don't need to translate them. - let (_, tc_args', _) = tcLookupDataFamInst env tc tc_args - Just tc_args' + let (rep_tc, tc_args', _) = tcLookupDataFamInst env tc tc_args + if rep_tc == dataConTyCon dc + then Just tc_args' + else Nothing guessConLikeUnivTyArgsFromResTy _ res_ty (PatSynCon ps) = do -- We are successful if we managed to instantiate *every* univ_tv of con. -- This is difficult and bound to fail in some cases, see @@ -998,7 +964,7 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do -- | Returns (Just vi) if at least one member of each ConLike in the COMPLETE -- set satisfies the oracle -- --- Internally uses and updates the ConLikeSets in vi_cache. +-- Internally uses and updates the ConLikeSets in vi_rcm. -- -- NB: Does /not/ filter each ConLikeSet with the oracle; members may -- remain that do not statisfy it. This lazy approach just @@ -1007,17 +973,31 @@ ensureInhabited :: Nabla -> VarInfo -> MaybeT DsM VarInfo ensureInhabited nabla vi = case vi_bot vi of MaybeBot -> pure vi -- The |-Bot rule from the paper IsBot -> pure vi - IsNotBot -> lift (initPossibleMatches (nabla_ty_st nabla) vi) >>= inst_complete_sets + IsNotBot -> lift (add_matches vi) >>= inst_complete_sets where + add_matches :: VarInfo -> DsM VarInfo + add_matches vi = do + res <- pmTopNormaliseType (nabla_ty_st nabla) (vi_ty vi) + rcm <- case reprTyCon_maybe (normalisedSourceType res) of + Just tc -> addTyConMatches tc (vi_rcm vi) + Nothing -> addCompleteMatches (vi_rcm vi) + pure vi{ vi_rcm = rcm } + + reprTyCon_maybe :: Type -> Maybe TyCon + reprTyCon_maybe ty = case splitTyConApp_maybe ty of + Nothing -> Nothing + Just (tc, _args) -> case tyConFamInst_maybe tc of + Nothing -> Just tc + Just (tc_fam, _) -> Just tc_fam + -- | This is the |-Inst rule from the paper (section 4.5). Tries to -- find an inhabitant in every complete set by instantiating with one their -- constructors. If there is any complete set where we can't find an -- inhabitant, the whole thing is uninhabited. inst_complete_sets :: VarInfo -> MaybeT DsM VarInfo - inst_complete_sets vi at VI{ vi_cache = NoPM } = pure vi - inst_complete_sets vi at VI{ vi_cache = PM ms } = do - ms <- traverse (\cs -> inst_complete_set vi cs (uniqDSetToList cs)) ms - pure vi{ vi_cache = PM ms } + inst_complete_sets vi at VI{ vi_rcm = rcm } = do + rcm' <- trvRcm (\cls -> inst_complete_set vi cls (uniqDSetToList cls)) rcm + pure vi{ vi_rcm = rcm' } inst_complete_set :: VarInfo -> ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet -- (inst_complete_set cs cls) iterates over cls, deleting from cs @@ -1052,7 +1032,7 @@ ensureInhabited nabla vi = case vi_bot vi of ] -- | Checks if every 'VarInfo' in the term oracle has still an inhabited --- 'vi_cache', considering the current type information in 'Nabla'. +-- 'vi_rcm', considering the current type information in 'Nabla'. -- This check is necessary after having matched on a GADT con to weed out -- impossible matches. ensureAllInhabited :: Nabla -> DsM (Maybe Nabla) @@ -1111,7 +1091,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- Do the same for negative info let add_refut nabla nalt = addNotConCt nabla y nalt nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) - -- vi_cache will be updated in addNotConCt, so we are good to + -- vi_rcm will be updated in addNotConCt, so we are good to -- go! pure nabla_neg @@ -1123,7 +1103,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do - let VI ty pos neg bot cache = lookupVarInfo ts x + let VI ty pos neg bot rcm = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -1142,7 +1122,8 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do MaybeT $ addPmCts nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = (alt, tvs, args):pos - let nabla_with bot = nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot cache)) reps} + let nabla_with bot = + nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot rcm)) reps} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -1574,7 +1555,7 @@ provideEvidence = go try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. try_instantiate x xs n nabla = do - (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) let build_newtype (x, nabla) (_ty, dc, arg_ty) = do y <- lift $ mkPmId arg_ty -- Newtypes don't have existentials (yet?!), so passing an empty @@ -1586,10 +1567,12 @@ provideEvidence = go Just (y, newty_nabla) -> do -- Pick a COMPLETE set and instantiate it (n at max). Take care of ⊥. let vi = lookupVarInfo (nabla_tm_st newty_nabla) y - vi <- initPossibleMatches (nabla_ty_st newty_nabla) vi - mb_cls <- pickMinimalCompleteSet newty_nabla (vi_cache vi) + rcm <- case splitTyConApp_maybe rep_ty of + Nothing -> pure (vi_rcm vi) + Just (tc, _) -> addTyConMatches tc (vi_rcm vi) + mb_cls <- pickMinimalCompleteSet rep_ty rcm case uniqDSetToList <$> mb_cls of - Just cls@(_:_) -> instantiate_cons y core_ty xs n newty_nabla cls + Just cls@(_:_) -> instantiate_cons y rep_ty xs n newty_nabla cls Just [] | vi_bot vi == IsNotBot -> pure [] -- Either ⊥ is still possible (think Void) or there are no COMPLETE -- sets available, so we can assume it's inhabited @@ -1631,13 +1614,15 @@ provideEvidence = go other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls pure (con_nablas ++ other_cons_nablas) -pickMinimalCompleteSet :: Nabla -> PossibleMatches -> DsM (Maybe ConLikeSet) -pickMinimalCompleteSet _ NoPM = pure Nothing --- TODO: First prune sets with type info in nabla. But this is good enough for --- now and less costly. See #17386. -pickMinimalCompleteSet _ (PM clss) = do - tracePm "pickMinimalCompleteSet" (ppr $ NonEmpty.toList clss) - pure (Just (minimumBy (comparing sizeUniqDSet) clss)) +pickMinimalCompleteSet :: Type -> ResidualCompleteMatches -> DsM (Maybe ConLikeSet) +pickMinimalCompleteSet ty rcm = do + env <- dsGetFamInstEnvs + pure $ case filter (all (is_valid env) . uniqDSetToList) (getRcm rcm) of + [] -> Nothing + clss' -> Just (minimumBy (comparing sizeUniqDSet) clss') + where + is_valid :: FamInstEnvs -> ConLike -> Bool + is_valid env cl = isJust (guessConLikeUnivTyArgsFromResTy env ty cl) -- | Finds a representant of the semantic equality class of the given @e at . -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -24,8 +24,8 @@ module GHC.HsToCore.PmCheck.Types ( literalToPmLit, negatePmLit, overloadPmLit, pmLitAsStringLit, coreExprAsPmLit, - -- * Caching partially matched COMPLETE sets - ConLikeSet, PossibleMatches(..), + -- * Caching residual COMPLETE sets + ConLikeSet, ResidualCompleteMatches(..), getRcm, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -69,10 +69,10 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) import Data.Foldable (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ratio import qualified Data.Semigroup as Semi @@ -415,21 +415,31 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show -type ConLikeSet = UniqDSet ConLike +-- | A data type that caches for the 'VarInfo' of @x@ the results of querying +-- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for +-- which we already know @x /~ K@ from these sets. +-- +-- For motivation, see Section 5.3 in Lower Your Guards. +data ResidualCompleteMatches + = RCM + { rcm_vanilla :: !(Maybe ConLikeSet) + -- ^ The residual set for the vanilla COMPLETE set from the data defn. + -- Tracked separately from 'rcm_pragmas', because it might only be + -- known much later (when we have enough type information to see the 'TyCon' + -- of the match), or not at all even. Until that happens, it is 'Nothing'. + , rcm_pragmas :: !(Maybe [ConLikeSet]) + -- ^ The residual sets for /all/ COMPLETE sets from pragmas that are + -- visible when compiling this module. Querying that set with + -- 'dsGetCompleteMatches' requires 'DsM', so we initialise it with 'Nothing' + -- until first needed in a 'DsM' context. + } --- | A data type caching the results of 'completeMatchConLikes' with support for --- deletion of constructors that were already matched on. -data PossibleMatches - = PM (NonEmpty.NonEmpty ConLikeSet) - -- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE set - -- 'NonEmpty' because the empty case would mean that the type has no COMPLETE - -- set at all, for which we have 'NoPM'. - | NoPM - -- ^ No COMPLETE set for this type (yet). Think of overloaded literals. +getRcm :: ResidualCompleteMatches -> [ConLikeSet] +getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas -instance Outputable PossibleMatches where - ppr (PM cs) = ppr (NonEmpty.toList cs) - ppr NoPM = text "" +instance Outputable ResidualCompleteMatches where + -- formats as "[{Nothing,Just},{P,Q}]" + ppr rcm = ppr (getRcm rcm) -- | Either @Indirect x@, meaning the value is represented by that of @x@, or -- an @Entry@ containing containing the actual value it represents. @@ -516,8 +526,8 @@ data TmState -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". --- Also caches the type ('vi_ty'), the 'PossibleMatches' of a COMPLETE set --- ('vi_cache'). +-- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set +-- ('vi_rcm'). -- -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo @@ -559,7 +569,7 @@ data VarInfo -- * 'IsBot': @x ~ ⊥@ -- * 'IsNotBot': @x ≁ ⊥@ - , vi_cache :: !PossibleMatches + , vi_rcm :: !ResidualCompleteMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of -- possible constructors of each COMPLETE set. So, if it's not in here, we -- can't possibly match on it. Complementary to 'vi_neg'. We still need it ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -38,7 +38,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.IfaceToCore ( tcIfaceDecl, tcIfaceRules, tcIfaceInst, tcIfaceFamInst - , tcIfaceAnnotations, tcIfaceCompleteSigs ) + , tcIfaceAnnotations, tcIfaceCompleteMatches ) import GHC.Driver.Session import GHC.Driver.Backend @@ -479,7 +479,7 @@ loadInterface doc_str mod from ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) ; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface) ; new_eps_anns <- tcIfaceAnnotations (mi_anns iface) - ; new_eps_complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + ; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT", @@ -509,9 +509,7 @@ loadInterface doc_str mod from eps_rule_base = extendRuleBaseList (eps_rule_base eps) new_eps_rules, eps_complete_matches - = extendCompleteMatchMap - (eps_complete_matches eps) - new_eps_complete_sigs, + = eps_complete_matches eps ++ new_eps_complete_matches, eps_inst_env = extendInstEnvList (eps_inst_env eps) new_eps_insts, eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps) @@ -1037,9 +1035,8 @@ initExternalPackageState home_unit eps_fam_inst_env = emptyFamInstEnv, eps_rule_base = mkRuleBase builtinRules', -- Initialise the EPS rule pool with the built-in rules - eps_mod_fam_inst_env - = emptyModuleEnv, - eps_complete_matches = emptyUFM, + eps_mod_fam_inst_env = emptyModuleEnv, + eps_complete_matches = [], eps_ann_env = emptyAnnEnv, eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0 , n_insts_in = 0, n_insts_out = 0 @@ -1181,7 +1178,7 @@ pprModIface iface at ModIface{ mi_final_exts = exts } , ppr (mi_warns iface) , pprTrustInfo (mi_trust iface) , pprTrustPkg (mi_trust_pkg iface) - , vcat (map ppr (mi_complete_sigs iface)) + , vcat (map ppr (mi_complete_matches iface)) , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface)) , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface)) , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface)) ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -57,6 +57,7 @@ import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Name.Env import GHC.Types.Name.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Utils.Error import GHC.Utils.Outputable @@ -220,7 +221,7 @@ mkIface_ hsc_env md_anns = anns, md_types = type_env, md_exports = exports, - md_complete_sigs = complete_sigs } + md_complete_matches = complete_matches } -- NB: notice that mkIface does not look at the bindings -- only at the TypeEnv. The previous Tidy phase has -- put exactly the info into the TypeEnv that we want @@ -256,7 +257,7 @@ mkIface_ hsc_env iface_fam_insts = map famInstToIfaceFamInst fam_insts trust_info = setSafeMode safe_mode annotations = map mkIfaceAnnotation anns - icomplete_sigs = map mkIfaceCompleteSig complete_sigs + icomplete_matches = map mkIfaceCompleteMatch complete_matches ModIface { mi_module = this_mod, @@ -285,7 +286,7 @@ mkIface_ hsc_env mi_hpc = isHpcUsed hpc_info, mi_trust = trust_info, mi_trust_pkg = pkg_trust_req, - mi_complete_sigs = icomplete_sigs, + mi_complete_matches = icomplete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -322,8 +323,9 @@ mkIface_ hsc_env ************************************************************************ -} -mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch -mkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc +mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch +mkIfaceCompleteMatch cls = + IfaceCompleteMatch (map conLikeName (uniqDSetToList cls)) {- ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -324,11 +324,11 @@ data IfaceAnnotation type IfaceAnnTarget = AnnTarget OccName -data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName +newtype IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] instance Outputable IfaceCompleteMatch where - ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls - <+> dcolon <+> ppr ty + ppr (IfaceCompleteMatch cls) = text "COMPLETE" <> colon <+> ppr cls + @@ -2481,8 +2481,8 @@ instance Binary IfaceTyConParent where return $ IfDataInstance ax pr ty instance Binary IfaceCompleteMatch where - put_ bh (IfaceCompleteMatch cs ts) = put_ bh cs >> put_ bh ts - get bh = IfaceCompleteMatch <$> get bh <*> get bh + put_ bh (IfaceCompleteMatch cs) = put_ bh cs + get bh = IfaceCompleteMatch <$> get bh {- @@ -2638,7 +2638,7 @@ instance NFData IfaceConAlt where IfaceLitAlt lit -> lit `seq` () instance NFData IfaceCompleteMatch where - rnf (IfaceCompleteMatch f1 f2) = rnf f1 `seq` rnf f2 + rnf (IfaceCompleteMatch f1) = rnf f1 instance NFData IfaceRule where rnf (IfaceRule f1 f2 f3 f4 f5 f6 f7 f8) = ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -142,7 +142,7 @@ mkBootModDetailsTc hsc_env tcg_patsyns = pat_syns, tcg_insts = insts, tcg_fam_insts = fam_insts, - tcg_complete_matches = complete_sigs, + tcg_complete_matches = complete_matches, tcg_mod = this_mod } = -- This timing isn't terribly useful since the result isn't forced, but @@ -150,13 +150,13 @@ mkBootModDetailsTc hsc_env Err.withTiming dflags (text "CoreTidy"<+>brackets (ppr this_mod)) (const ()) $ - return (ModDetails { md_types = type_env' - , md_insts = insts' - , md_fam_insts = fam_insts - , md_rules = [] - , md_anns = [] - , md_exports = exports - , md_complete_sigs = complete_sigs + return (ModDetails { md_types = type_env' + , md_insts = insts' + , md_fam_insts = fam_insts + , md_rules = [] + , md_anns = [] + , md_exports = exports + , md_complete_matches = complete_matches }) where dflags = hsc_dflags hsc_env @@ -345,22 +345,22 @@ three places this is actioned: -} tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails) -tidyProgram hsc_env (ModGuts { mg_module = mod - , mg_exports = exports - , mg_rdr_env = rdr_env - , mg_tcs = tcs - , mg_insts = cls_insts - , mg_fam_insts = fam_insts - , mg_binds = binds - , mg_patsyns = patsyns - , mg_rules = imp_rules - , mg_anns = anns - , mg_complete_sigs = complete_sigs - , mg_deps = deps - , mg_foreign = foreign_stubs - , mg_foreign_files = foreign_files - , mg_hpc_info = hpc_info - , mg_modBreaks = modBreaks +tidyProgram hsc_env (ModGuts { mg_module = mod + , mg_exports = exports + , mg_rdr_env = rdr_env + , mg_tcs = tcs + , mg_insts = cls_insts + , mg_fam_insts = fam_insts + , mg_binds = binds + , mg_patsyns = patsyns + , mg_rules = imp_rules + , mg_anns = anns + , mg_complete_matches = complete_matches + , mg_deps = deps + , mg_foreign = foreign_stubs + , mg_foreign_files = foreign_files + , mg_hpc_info = hpc_info + , mg_modBreaks = modBreaks }) = Err.withTiming dflags @@ -465,13 +465,13 @@ tidyProgram hsc_env (ModGuts { mg_module = mod cg_modBreaks = modBreaks, cg_spt_entries = spt_entries }, - ModDetails { md_types = tidy_type_env, - md_rules = tidy_rules, - md_insts = tidy_cls_insts, - md_fam_insts = fam_insts, - md_exports = exports, - md_anns = anns, -- are already tidy - md_complete_sigs = complete_sigs + ModDetails { md_types = tidy_type_env, + md_rules = tidy_rules, + md_insts = tidy_cls_insts, + md_fam_insts = fam_insts, + md_exports = exports, + md_anns = anns, -- are already tidy + md_complete_matches = complete_matches }) } where ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -17,7 +17,7 @@ module GHC.IfaceToCore ( typecheckIfacesForMerging, typecheckIfaceForInstantiate, tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, - tcIfaceAnnotations, tcIfaceCompleteSigs, + tcIfaceAnnotations, tcIfaceCompleteMatches, tcIfaceExpr, -- Desired by HERMIT (#7683) tcIfaceGlobal, tcIfaceOneShot @@ -67,6 +67,7 @@ import GHC.Types.Name.Set import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Unit.Module import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet ( mkUniqDSet ) import GHC.Types.Unique.Supply import GHC.Utils.Outputable import GHC.Data.Maybe @@ -180,7 +181,7 @@ typecheckIface iface ; exports <- ifaceExportNames (mi_exports iface) -- Complete Sigs - ; complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + ; complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) -- Finished ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface), @@ -194,7 +195,7 @@ typecheckIface iface , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } } @@ -393,14 +394,14 @@ typecheckIfacesForMerging mod ifaces tc_env_var = rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) exports <- ifaceExportNames (mi_exports iface) - complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) return $ ModDetails { md_types = type_env , md_insts = insts , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } return (global_type_env, details) @@ -432,14 +433,14 @@ typecheckIfaceForInstantiate nsubst iface = rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) exports <- ifaceExportNames (mi_exports iface) - complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) return $ ModDetails { md_types = type_env , md_insts = insts , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } -- Note [Resolving never-exported Names] @@ -1147,11 +1148,14 @@ tcIfaceAnnTarget (ModuleTarget mod) = do ************************************************************************ -} -tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch] -tcIfaceCompleteSigs = mapM tcIfaceCompleteSig +tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch] +tcIfaceCompleteMatches = mapM tcIfaceCompleteMatch -tcIfaceCompleteSig :: IfaceCompleteMatch -> IfL CompleteMatch -tcIfaceCompleteSig (IfaceCompleteMatch ms t) = return (CompleteMatch ms t) +tcIfaceCompleteMatch :: IfaceCompleteMatch -> IfL CompleteMatch +tcIfaceCompleteMatch (IfaceCompleteMatch ms) = + mkUniqDSet <$> mapM (forkM doc . tcIfaceConLike) ms + where + doc = text "COMPLETE sig" <+> ppr ms {- ************************************************************************ @@ -1760,7 +1764,13 @@ tcIfaceDataCon :: Name -> IfL DataCon tcIfaceDataCon name = do { thing <- tcIfaceGlobal name ; case thing of AConLike (RealDataCon dc) -> return dc - _ -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) } + _ -> pprPanic "tcIfaceDataCon" (ppr name$$ ppr thing) } + +tcIfaceConLike :: Name -> IfL ConLike +tcIfaceConLike name = do { thing <- tcIfaceGlobal name + ; case thing of + AConLike cl -> return cl + _ -> pprPanic "tcIfaceConLike" (ppr name$$ ppr thing) } tcIfaceExtId :: Name -> IfL Id tcIfaceExtId name = do { thing <- tcIfaceGlobal name ===================================== compiler/GHC/IfaceToCore.hs-boot ===================================== @@ -11,9 +11,9 @@ import GHC.Core ( CoreRule ) import GHC.Driver.Types ( CompleteMatch ) import GHC.Types.Annotations ( Annotation ) -tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing -tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] -tcIfaceInst :: IfaceClsInst -> IfL ClsInst -tcIfaceFamInst :: IfaceFamInst -> IfL FamInst -tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] -tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch] +tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing +tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] +tcIfaceInst :: IfaceClsInst -> IfL ClsInst +tcIfaceFamInst :: IfaceFamInst -> IfL FamInst +tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] +tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch] ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -44,9 +44,8 @@ import GHC.Tc.Utils.TcMType import GHC.Core.Multiplicity import GHC.Core.FamInstEnv( normaliseType ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs ) -import GHC.Core.TyCon import GHC.Tc.Utils.TcType -import GHC.Core.Type (mkStrLitTy, tidyOpenType, splitTyConApp_maybe, mkCastTy) +import GHC.Core.Type (mkStrLitTy, tidyOpenType, mkCastTy) import GHC.Builtin.Types.Prim import GHC.Builtin.Types( mkBoxedTupleTy ) import GHC.Types.Id @@ -69,9 +68,9 @@ import GHC.Utils.Panic import GHC.Builtin.Names( ipClassName ) import GHC.Tc.Validity (checkValidType) import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Unique.Set import qualified GHC.LanguageExtensions as LangExt -import GHC.Core.ConLike import Control.Monad import Data.Foldable (find) @@ -197,112 +196,22 @@ tcTopBinds binds sigs -- The top level bindings are flattened into a giant -- implicitly-mutually-recursive LHsBinds - --- Note [Typechecking Complete Matches] --- Much like when a user bundled a pattern synonym, the result types of --- all the constructors in the match pragma must be consistent. --- --- If we allowed pragmas with inconsistent types then it would be --- impossible to ever match every constructor in the list and so --- the pragma would be useless. - - - - - --- This is only used in `tcCompleteSig`. We fold over all the conlikes, --- this accumulator keeps track of the first `ConLike` with a concrete --- return type. After fixing the return type, all other constructors with --- a fixed return type must agree with this. --- --- The fields of `Fixed` cache the first conlike and its return type so --- that we can compare all the other conlikes to it. The conlike is --- stored for error messages. --- --- `Nothing` in the case that the type is fixed by a type signature -data CompleteSigType = AcceptAny | Fixed (Maybe ConLike) TyCon - tcCompleteSigs :: [LSig GhcRn] -> TcM [CompleteMatch] tcCompleteSigs sigs = let - doOne :: Sig GhcRn -> TcM (Maybe CompleteMatch) - doOne c@(CompleteMatchSig _ _ lns mtc) - = fmap Just $ do - addErrCtxt (text "In" <+> ppr c) $ - case mtc of - Nothing -> infer_complete_match - Just tc -> check_complete_match tc - where - - checkCLTypes acc = foldM checkCLType (acc, []) (unLoc lns) - - infer_complete_match = do - (res, cls) <- checkCLTypes AcceptAny - case res of - AcceptAny -> failWithTc ambiguousError - Fixed _ tc -> return $ mkMatch cls tc - - check_complete_match tc_name = do - ty_con <- tcLookupLocatedTyCon tc_name - (_, cls) <- checkCLTypes (Fixed Nothing ty_con) - return $ mkMatch cls ty_con - - mkMatch :: [ConLike] -> TyCon -> CompleteMatch - mkMatch cls ty_con = CompleteMatch { - -- foldM is a left-fold and will have accumulated the ConLikes in - -- the reverse order. foldrM would accumulate in the correct order, - -- but would type-check the last ConLike first, which might also be - -- confusing from the user's perspective. Hence reverse here. - completeMatchConLikes = reverse (map conLikeName cls), - completeMatchTyCon = tyConName ty_con - } + doOne :: LSig GhcRn -> TcM (Maybe CompleteMatch) + -- We don't need to "type-check" COMPLETE signatures anymore; if their + -- combinations are invalid it will be found so at match sites. Hence we + -- keep '_mtc' only for backwards compatibility. + doOne (L loc c@(CompleteMatchSig _ext _src_txt (L _ ns) _mtc)) + = fmap Just $ setSrcSpan loc $ addErrCtxt (text "In" <+> ppr c) $ + mkUniqDSet <$> mapM (addLocM tcLookupConLike) ns doOne _ = return Nothing - ambiguousError :: SDoc - ambiguousError = - text "A type signature must be provided for a set of polymorphic" - <+> text "pattern synonyms." - - - -- See note [Typechecking Complete Matches] - checkCLType :: (CompleteSigType, [ConLike]) -> Located Name - -> TcM (CompleteSigType, [ConLike]) - checkCLType (cst, cs) n = do - cl <- addLocM tcLookupConLike n - let (_,_,_,_,_,_, res_ty) = conLikeFullSig cl - res_ty_con = fst <$> splitTyConApp_maybe res_ty - case (cst, res_ty_con) of - (AcceptAny, Nothing) -> return (AcceptAny, cl:cs) - (AcceptAny, Just tc) -> return (Fixed (Just cl) tc, cl:cs) - (Fixed mfcl tc, Nothing) -> return (Fixed mfcl tc, cl:cs) - (Fixed mfcl tc, Just tc') -> - if tc == tc' - then return (Fixed mfcl tc, cl:cs) - else case mfcl of - Nothing -> - addErrCtxt (text "In" <+> ppr cl) $ - failWithTc typeSigErrMsg - Just cl -> failWithTc (errMsg cl) - where - typeSigErrMsg :: SDoc - typeSigErrMsg = - text "Couldn't match expected type" - <+> quotes (ppr tc) - <+> text "with" - <+> quotes (ppr tc') - - errMsg :: ConLike -> SDoc - errMsg fcl = - text "Cannot form a group of complete patterns from patterns" - <+> quotes (ppr fcl) <+> text "and" <+> quotes (ppr cl) - <+> text "as they match different type constructors" - <+> parens (quotes (ppr tc) - <+> text "resp." - <+> quotes (ppr tc')) -- For some reason I haven't investigated further, the signatures come in -- backwards wrt. declaration order. So we reverse them here, because it makes -- a difference for incomplete match suggestions. - in mapMaybeM (addLocM doOne) (reverse sigs) -- process in declaration order + in mapMaybeM doOne $ reverse sigs tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id] -- A hs-boot file has only one BindGroup, and it only has type ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -45,12 +45,11 @@ module GHC.Tc.Types( IdBindingInfo(..), ClosedTypeId, RhsNames, IsGroupClosed(..), SelfBootInfo(..), - pprTcTyThingCategory, pprPECategory, CompleteMatch(..), + pprTcTyThingCategory, pprPECategory, CompleteMatch, -- Desugaring types DsM, DsLclEnv(..), DsGblEnv(..), - DsMetaEnv, DsMetaVal(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap, + DsMetaEnv, DsMetaVal(..), CompleteMatches, -- Template Haskell ThStage(..), SpliceType(..), PendingStuff(..), @@ -310,7 +309,7 @@ data DsGblEnv , ds_msgs :: IORef Messages -- Warning messages , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, -- possibly-imported things - , ds_complete_matches :: CompleteMatchMap + , ds_complete_matches :: CompleteMatches -- Additional complete pattern matches , ds_cc_st :: IORef CostCentreState -- Tracking indices for cost centre annotations @@ -602,7 +601,7 @@ data TcGblEnv tcg_static_wc :: TcRef WantedConstraints, -- ^ Wanted constraints of static forms. -- See Note [Constraints in static forms]. - tcg_complete_matches :: [CompleteMatch], + tcg_complete_matches :: CompleteMatches, -- ^ Tracking indices for cost centre annotations tcg_cc_st :: TcRef CostCentreState ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -64,8 +64,8 @@ module GHC.Tc.Utils.Env( topIdLvl, isBrackStage, -- New Ids - newDFunName, newFamInstTyConName, - newFamInstAxiomName, + newDFunName, + newFamInstTyConName, newFamInstAxiomName, mkStableIdFromString, mkStableIdFromName, mkWrapperName ) where ===================================== compiler/GHC/Types/Unique/DFM.hs ===================================== @@ -32,6 +32,7 @@ module GHC.Types.Unique.DFM ( addToUDFM_C_Directly, addToUDFM_Directly, addListToUDFM, + addListToUDFM_C, delFromUDFM, delListFromUDFM, adjustUDFM, @@ -41,6 +42,7 @@ module GHC.Types.Unique.DFM ( plusUDFM, plusUDFM_C, lookupUDFM, lookupUDFM_Directly, + lookupWithDefaultUDFM, lookupWithDefaultUDFM_Directly, elemUDFM, foldUDFM, eltsUDFM, @@ -68,6 +70,7 @@ import GHC.Prelude import GHC.Types.Unique ( Uniquable(..), Unique, getKey ) import GHC.Utils.Outputable +import GHC.Data.Maybe ( orElse ) import qualified Data.IntMap as M import Data.Data @@ -206,6 +209,10 @@ addListToUDFM = foldl' (\m (k, v) -> addToUDFM m k v) addListToUDFM_Directly :: UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly = foldl' (\m (k, v) -> addToUDFM_Directly m k v) +addListToUDFM_C + :: Uniquable key => (elt -> elt -> elt) -> UniqDFM key elt -> [(key,elt)] -> UniqDFM key elt +addListToUDFM_C f = foldl' (\m (k, v) -> addToUDFM_C f m k v) + addListToUDFM_Directly_C :: (elt -> elt -> elt) -> UniqDFM key elt -> [(Unique,elt)] -> UniqDFM key elt addListToUDFM_Directly_C f = foldl' (\m (k, v) -> addToUDFM_C_Directly f m k v) @@ -274,6 +281,12 @@ lookupUDFM (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey $ getUnique k) m lookupUDFM_Directly :: UniqDFM key elt -> Unique -> Maybe elt lookupUDFM_Directly (UDFM m _i) k = taggedFst `fmap` M.lookup (getKey k) m +lookupWithDefaultUDFM :: Uniquable key => UniqDFM key elt -> elt -> key -> elt +lookupWithDefaultUDFM m v k = lookupUDFM m k `orElse` v + +lookupWithDefaultUDFM_Directly :: UniqDFM key elt -> elt -> Unique -> elt +lookupWithDefaultUDFM_Directly m v k = lookupUDFM_Directly m k `orElse` v + elemUDFM :: Uniquable key => key -> UniqDFM key elt -> Bool elemUDFM k (UDFM m _i) = M.member (getKey $ getUnique k) m ===================================== docs/users_guide/exts/pragmas.rst ===================================== @@ -887,29 +887,6 @@ modules. ``COMPLETE`` pragmas should be thought of as asserting a universal truth about a set of patterns and as a result, should not be used to silence context specific incomplete match warnings. -When specifying a ``COMPLETE`` pragma, the result types of all patterns must -be consistent with each other. This is a sanity check as it would be impossible -to match on all the patterns if the types were inconsistent. - -The result type must also be unambiguous. Usually this can be inferred but -when all the pattern synonyms in a group are polymorphic in the constructor -the user must provide a type signature. :: - - class LL f where - go :: f a -> () - - instance LL [] where - go _ = () - - pattern T :: LL f => f a - pattern T <- (go -> ()) - - {-# COMPLETE T :: [] #-} - - -- No warning - foo :: [a] -> Int - foo T = 5 - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/pmcheck/complete_sigs/completesig15.hs → testsuite/tests/pmcheck/complete_sigs/T14422.hs ===================================== @@ -10,3 +10,6 @@ pattern P :: C f => f a pattern P <- (foo -> ()) {-# COMPLETE P #-} + +f :: C f => f a -> () +f P = () -- A complete match ===================================== testsuite/tests/pmcheck/complete_sigs/T18277.hs ===================================== @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +type List = [] + +pattern DefinitelyAString :: String -> String +pattern DefinitelyAString x = x +{-# COMPLETE DefinitelyAString #-} + +f :: String -> String +f (DefinitelyAString x) = x ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -1,7 +1,7 @@ test('completesig01', normal, compile, ['']) test('completesig02', normal, compile, ['']) test('Completesig03', normal, multimod_compile, ['Completesig03', '-Wall']) -test('completesig04', normal, compile_fail, ['']) +test('completesig04', normal, compile, ['-Wincomplete-patterns']) test('completesig05', normal, compile, ['']) test('completesig06', normal, compile, ['']) test('completesig07', normal, compile, ['']) @@ -12,7 +12,6 @@ test('completesig11', normal, compile, ['']) test('completesig12', normal, compile, ['']) test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) -test('completesig15', normal, compile_fail, ['']) test('T13021', normal, compile, ['']) test('T13363a', normal, compile, ['']) test('T13363b', normal, compile, ['']) @@ -22,6 +21,8 @@ test('T13965', normal, compile, ['']) test('T14059a', normal, compile, ['']) test('T14059b', expect_broken('14059'), compile, ['']) test('T14253', normal, compile, ['']) +test('T14422', normal, compile, ['']) test('T14851', normal, compile, ['']) test('T17149', normal, compile, ['']) test('T17386', normal, compile, ['']) +test('T18277', normal, compile, ['']) ===================================== testsuite/tests/pmcheck/complete_sigs/completesig04.hs ===================================== @@ -1,6 +1,12 @@ --- Test that a COMPLETE pragma over constructors of different types fails. +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +-- Test that a COMPLETE pragma over constructors of different types is a valid +-- declaration, but that it's not suggested in any warning. module TyMismatch where -data E = L | R +data T = A | B | C -{-# COMPLETE Just, L #-} +{-# COMPLETE Just, A #-} + +f A = () -- should not suggest 'Just' + +g (Just _) = () -- should not suggest 'A' ===================================== testsuite/tests/pmcheck/complete_sigs/completesig04.stderr ===================================== @@ -1,4 +1,11 @@ -completesig04.hs:6:1: error: - • Cannot form a group of complete patterns from patterns ‘Just’ and ‘L’ as they match different type constructors (‘Maybe’ resp. ‘E’) - • In {-# COMPLETE Just, L #-} +completesig04.hs:10:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: + Patterns not matched: + B + C + +completesig04.hs:12:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘g’: Patterns not matched: Nothing ===================================== testsuite/tests/pmcheck/complete_sigs/completesig15.stderr deleted ===================================== @@ -1,4 +0,0 @@ - -completesig15.hs:12:1: error: - • A type signature must be provided for a set of polymorphic pattern synonyms. - • In {-# COMPLETE P #-} ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -88,7 +88,7 @@ test('T17112', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17207', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17207b', expect_broken(17207), compile, +test('T17207b', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17208', expect_broken(17208), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/db1732479f7ed43e76663c6032304beb1d2cdb56 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/db1732479f7ed43e76663c6032304beb1d2cdb56 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 16:56:20 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 02 Sep 2020 12:56:20 -0400 Subject: [Git][ghc/ghc][wip/T14422] PmCheck: Disattach COMPLETE pragma lookup from TyCons Message-ID: <5f4fceb4b1b_80b1087a6f8102927a2@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14422 at Glasgow Haskell Compiler / GHC Commits: 9b9cfcc6 by Sebastian Graf at 2020-09-02T18:55:20+02:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. - - - - - 22 changed files: - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/IfaceToCore.hs-boot - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Env.hs - docs/users_guide/exts/pragmas.rst - testsuite/tests/pmcheck/complete_sigs/completesig15.hs → testsuite/tests/pmcheck/complete_sigs/T14422.hs - + testsuite/tests/pmcheck/complete_sigs/T18277.hs - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/complete_sigs/completesig04.hs - testsuite/tests/pmcheck/complete_sigs/completesig04.stderr - − testsuite/tests/pmcheck/complete_sigs/completesig15.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Driver.Types ( lookupIfaceByModule, emptyPartialModIface, emptyFullModIface, lookupHptByModule, PackageInstEnv, PackageFamInstEnv, PackageRuleBase, - PackageCompleteMatchMap, + PackageCompleteMatches, mkSOName, mkHsSOName, soExt, @@ -146,8 +146,7 @@ module GHC.Driver.Types ( handleFlagWarnings, printOrThrowWarnings, -- * COMPLETE signature - CompleteMatch(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap, + ConLikeSet, CompleteMatch, CompleteMatches, -- * Exstensible Iface fields ExtensibleFields(..), FieldName, @@ -734,7 +733,7 @@ lookupIfaceByModule hpt pit mod -- of its own, but it doesn't seem worth the bother. hptCompleteSigs :: HscEnv -> [CompleteMatch] -hptCompleteSigs = hptAllThings (md_complete_sigs . hm_details) +hptCompleteSigs = hptAllThings (md_complete_matches . hm_details) -- | Find all the instance declarations (of classes and families) from -- the Home Package Table filtered by the provided predicate function. @@ -1092,7 +1091,7 @@ data ModIface_ (phase :: ModIfacePhase) -- itself) but imports some trustworthy modules from its own -- package (which does require its own package be trusted). -- See Note [Trust Own Package] in GHC.Rename.Names - mi_complete_sigs :: [IfaceCompleteMatch], + mi_complete_matches :: [IfaceCompleteMatch], mi_doc_hdr :: Maybe HsDocString, -- ^ Module header. @@ -1183,7 +1182,7 @@ instance Binary ModIface where mi_hpc = hpc_info, mi_trust = trust, mi_trust_pkg = trust_pkg, - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1229,7 +1228,7 @@ instance Binary ModIface where put_ bh hpc_info put_ bh trust put_ bh trust_pkg - put_ bh complete_sigs + put_ bh complete_matches lazyPut bh doc_hdr lazyPut bh decl_docs lazyPut bh arg_docs @@ -1262,7 +1261,7 @@ instance Binary ModIface where hpc_info <- get bh trust <- get bh trust_pkg <- get bh - complete_sigs <- get bh + complete_matches <- get bh doc_hdr <- lazyGet bh decl_docs <- lazyGet bh arg_docs <- lazyGet bh @@ -1286,7 +1285,7 @@ instance Binary ModIface where mi_trust = trust, mi_trust_pkg = trust_pkg, -- And build the cached values - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1331,7 +1330,7 @@ emptyPartialModIface mod mi_hpc = False, mi_trust = noIfaceTrustInfo, mi_trust_pkg = False, - mi_complete_sigs = [], + mi_complete_matches = [], mi_doc_hdr = Nothing, mi_decl_docs = emptyDeclDocMap, mi_arg_docs = emptyArgDocMap, @@ -1387,7 +1386,7 @@ data ModDetails md_rules :: ![CoreRule], -- ^ Domain may include 'Id's from other modules md_anns :: ![Annotation], -- ^ Annotations present in this module: currently -- they only annotate things also declared in this module - md_complete_sigs :: [CompleteMatch] + md_complete_matches :: [CompleteMatch] -- ^ Complete match pragmas for this module } @@ -1400,7 +1399,7 @@ emptyModDetails md_rules = [], md_fam_insts = [], md_anns = [], - md_complete_sigs = [] } + md_complete_matches = [] } -- | Records the modules directly imported by a module for extracting e.g. -- usage information, and also to give better error message @@ -1463,7 +1462,7 @@ data ModGuts -- ^ Files to be compiled with the C compiler mg_warns :: !Warnings, -- ^ Warnings declared in the module mg_anns :: [Annotation], -- ^ Annotations declared in this module - mg_complete_sigs :: [CompleteMatch], -- ^ Complete Matches + mg_complete_matches :: [CompleteMatch], -- ^ Complete Matches mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module @@ -2684,7 +2683,7 @@ type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv type PackageAnnEnv = AnnEnv -type PackageCompleteMatchMap = CompleteMatchMap +type PackageCompleteMatches = CompleteMatches -- | Information about other packages that we have slurped in by reading -- their interface files @@ -2746,8 +2745,8 @@ data ExternalPackageState -- from all the external-package modules eps_ann_env :: !PackageAnnEnv, -- ^ The total 'AnnEnv' accumulated -- from all the external-package modules - eps_complete_matches :: !PackageCompleteMatchMap, - -- ^ The total 'CompleteMatchMap' accumulated + eps_complete_matches :: !PackageCompleteMatches, + -- ^ The total 'CompleteMatches' accumulated -- from all the external-package modules eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external @@ -3203,36 +3202,13 @@ byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) ------------------------------------------- +type ConLikeSet = UniqDSet ConLike + -- | A list of conlikes which represents a complete pattern match. -- These arise from @COMPLETE@ signatures. +type CompleteMatch = ConLikeSet --- See Note [Implementation of COMPLETE signatures] -data CompleteMatch = CompleteMatch { - completeMatchConLikes :: [Name] - -- ^ The ConLikes that form a covering family - -- (e.g. Nothing, Just) - , completeMatchTyCon :: Name - -- ^ The TyCon that they cover (e.g. Maybe) - } - -instance Outputable CompleteMatch where - ppr (CompleteMatch cl ty) = text "CompleteMatch:" <+> ppr cl - <+> dcolon <+> ppr ty - --- | A map keyed by the 'completeMatchTyCon' which has type Name. - --- See Note [Implementation of COMPLETE signatures] -type CompleteMatchMap = UniqFM Name [CompleteMatch] - -mkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap -mkCompleteMatchMap = extendCompleteMatchMap emptyUFM - -extendCompleteMatchMap :: CompleteMatchMap -> [CompleteMatch] - -> CompleteMatchMap -extendCompleteMatchMap = foldl' insertMatch - where - insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap - insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c] +type CompleteMatches = [CompleteMatch] {- Note [Implementation of COMPLETE signatures] @@ -3252,33 +3228,14 @@ function, it gives rise to a total function. An example is: booleanToInt F = 0 booleanToInt T = 1 -COMPLETE sets are represented internally in GHC with the CompleteMatch data -type. For example, {-# COMPLETE F, T #-} would be represented as: - - CompleteMatch { complateMatchConLikes = [F, T] - , completeMatchTyCon = Boolean } - -Note that GHC was able to infer the completeMatchTyCon (Boolean), but for the -cases in which it's ambiguous, you can also explicitly specify it in the source -language by writing this: - - {-# COMPLETE F, T :: Boolean #-} - -For efficiency purposes, GHC collects all of the CompleteMatches that it knows -about into a CompleteMatchMap, which is a map that is keyed by the -completeMatchTyCon. In other words, you could have a multiple COMPLETE sets -for the same TyCon: - - {-# COMPLETE F, T1 :: Boolean #-} - {-# COMPLETE F, T2 :: Boolean #-} +COMPLETE sets are represented internally in GHC a set of 'ConLike's. For +example, {-# COMPLETE F, T #-} would be represented as: -And looking up the values in the CompleteMatchMap associated with Boolean -would give you [CompleteMatch [F, T1] Boolean, CompleteMatch [F, T2] Boolean]. -dsGetCompleteMatches in GHC.HsToCore.Quote accomplishes this lookup. + {F, T} -Also see Note [Typechecking Complete Matches] in GHC.Tc.Gen.Bind for a more detailed -explanation for how GHC ensures that all the conlikes in a COMPLETE set are -consistent. +GHC collects all COMPLETE pragmas from the current module and from imports +into a field in the DsM environment, which can be accessed with +dsGetCompleteMatches from "GHC.HsToCore.Monad". -} -- | Foreign language of the phase if the phase deals with a foreign code ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -224,7 +224,7 @@ deSugar hsc_env mg_modBreaks = modBreaks, mg_safe_haskell = safe_mode, mg_trust_pkg = imp_trust_own_pkg imports, - mg_complete_sigs = complete_matches, + mg_complete_matches = complete_matches, mg_doc_hdr = doc_hdr, mg_decl_docs = decl_docs, mg_arg_docs = arg_docs ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -88,7 +88,6 @@ import GHC.Driver.Ppr import GHC.Utils.Error import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Types.Unique.FM ( lookupWithDefaultUFM_Directly ) import GHC.Types.Literal ( mkLitString ) import GHC.Types.CostCentre.State @@ -210,13 +209,15 @@ mkDsEnvsFromTcGbl :: MonadIO m -> m (DsGblEnv, DsLclEnv) mkDsEnvsFromTcGbl hsc_env msg_var tcg_env = do { cc_st_var <- liftIO $ newIORef newCostCentreState + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env this_mod = tcg_mod tcg_env type_env = tcg_type_env tcg_env rdr_env = tcg_rdr_env tcg_env fam_inst_env = tcg_fam_inst_env tcg_env - complete_matches = hptCompleteSigs hsc_env - ++ tcg_complete_matches tcg_env + !complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ tcg_complete_matches tcg_env -- from the current module + ++ eps_complete_matches eps -- from imports ; return $ mkDsEnvs dflags this_mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches } @@ -239,13 +240,15 @@ initDsWithModGuts :: HscEnv -> ModGuts -> DsM a -> IO (Messages, Maybe a) initDsWithModGuts hsc_env guts thing_inside = do { cc_st_var <- newIORef newCostCentreState ; msg_var <- newIORef emptyMessages + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts) rdr_env = mg_rdr_env guts fam_inst_env = mg_fam_inst_env guts this_mod = mg_module guts - complete_matches = hptCompleteSigs hsc_env - ++ mg_complete_sigs guts + !complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ mg_complete_matches guts -- from the current module + ++ eps_complete_matches eps -- from imports bindsToIds (NonRec v _) = [v] bindsToIds (Rec binds) = map fst binds @@ -281,7 +284,7 @@ initTcDsForSolver thing_inside thing_inside } mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv - -> IORef Messages -> IORef CostCentreState -> [CompleteMatch] + -> IORef Messages -> IORef CostCentreState -> CompleteMatches -> (DsGblEnv, DsLclEnv) mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches @@ -290,7 +293,6 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod) NotBoot real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1) - completeMatchMap = mkCompleteMatchMap complete_matches gbl_env = DsGblEnv { ds_mod = mod , ds_fam_inst_env = fam_inst_env , ds_if_env = (if_genv, if_lenv) @@ -299,7 +301,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var (mkHomeUnitFromFlags dflags) rdr_env , ds_msgs = msg_var - , ds_complete_matches = completeMatchMap + , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv @@ -533,18 +535,9 @@ dsGetFamInstEnvs dsGetMetaEnv :: DsM (NameEnv DsMetaVal) dsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) } --- | The @COMPLETE@ pragmas provided by the user for a given `TyCon`. -dsGetCompleteMatches :: TyCon -> DsM [CompleteMatch] -dsGetCompleteMatches tc = do - eps <- getEps - env <- getGblEnv - -- We index into a UniqFM from Name -> elt, for tyCon it holds that - -- getUnique (tyConName tc) == getUnique tc. So we lookup using the - -- unique directly instead. - let lookup_completes ufm = lookupWithDefaultUFM_Directly ufm [] (getUnique tc) - eps_matches_list = lookup_completes $ eps_complete_matches eps - env_matches_list = lookup_completes $ ds_complete_matches env - return $ eps_matches_list ++ env_matches_list +-- | The @COMPLETE@ pragmas that are in scope. +dsGetCompleteMatches :: DsM CompleteMatches +dsGetCompleteMatches = ds_complete_matches <$> getGblEnv dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal) dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (dsl_meta env) name) } ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -66,13 +66,13 @@ import GHC.Core.TyCo.Rep import GHC.Core.Type import GHC.Tc.Solver (tcNormalise, tcCheckSatisfiability) import GHC.Core.Unify (tcMatchTy) -import GHC.Tc.Types (completeMatchConLikes) import GHC.Core.Coercion import GHC.Utils.Monad hiding (foldlM) import GHC.HsToCore.Monad hiding (foldlM) import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv +import Control.Applicative ((<|>)) import Control.Monad (guard, mzero, when) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict @@ -80,7 +80,6 @@ import Data.Bifunctor (second) import Data.Either (partitionEithers) import Data.Foldable (foldlM, minimumBy, toList) import Data.List (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ord (comparing) import qualified Data.Semigroup as Semigroup import Data.Tuple (swap) @@ -105,11 +104,54 @@ mkPmId ty = getUniqueM >>= \unique -> ----------------------------------------------- -- * Caching possible matches of a COMPLETE set -markMatched :: ConLike -> PossibleMatches -> PossibleMatches -markMatched _ NoPM = NoPM -markMatched con (PM ms) = PM (del_one_con con <$> ms) +-- | Traverse the COMPLETE sets of 'ResidualCompleteMatches'. +trvRcm :: Applicative f => (ConLikeSet -> f ConLikeSet) -> ResidualCompleteMatches -> f ResidualCompleteMatches +trvRcm f (RCM vanilla pragmas) = RCM <$> traverse f vanilla + <*> traverse (traverse f) pragmas +-- | Update the COMPLETE sets of 'ResidualCompleteMatches'. +updRcm :: (ConLikeSet -> ConLikeSet) -> ResidualCompleteMatches -> ResidualCompleteMatches +updRcm f (RCM vanilla pragmas) = RCM (f <$> vanilla) (fmap f <$> pragmas) + +-- | A pseudo-'CompleteMatch' for the vanilla complete set of the given data +-- 'TyCon'. +-- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ +vanillaCompleteMatchTC :: TyCon -> Maybe ConLikeSet +vanillaCompleteMatchTC tc = + let -- | TYPE acts like an empty data type on the term-level (#14086), but + -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a + -- special case. + mb_dcs | tc == tYPETyCon = Just [] + | otherwise = tyConDataCons_maybe tc + in mkUniqDSet . map RealDataCon <$> mb_dcs + +-- | Initialise from 'dsGetCompleteMatches' (containing all COMPLETE pragmas) +-- if the given 'ResidualCompleteMatches' were empty. +addCompleteMatches :: ResidualCompleteMatches -> DsM ResidualCompleteMatches +addCompleteMatches (RCM v Nothing) = RCM v . Just <$> dsGetCompleteMatches +addCompleteMatches rcm = pure rcm + +-- | Adds the declared 'CompleteMatches' from COMPLETE pragmas, as well as the +-- vanilla data defn if it is a 'DataCon'. +addConLikeMatches :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addConLikeMatches (RealDataCon dc) rcm = addTyConMatches (dataConTyCon dc) rcm +addConLikeMatches (PatSynCon _) rcm = addCompleteMatches rcm + +-- | Adds +-- * the 'CompleteMatches' from COMPLETE pragmas +-- * and the /vanilla/ 'CompleteMatch' from the data 'TyCon' +-- to the 'ResidualCompleteMatches', if not already present. +addTyConMatches :: TyCon -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addTyConMatches tc rcm = add_tc_match <$> addCompleteMatches rcm where - del_one_con = flip delOneFromUniqDSet + -- | Add the vanilla COMPLETE set from the data defn, if any. But only if + -- it's not already present. + add_tc_match rcm + = rcm{rcm_vanilla = rcm_vanilla rcm <|> vanillaCompleteMatchTC tc} + +markMatched :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +markMatched cl rcm = do + rcm' <- addConLikeMatches cl rcm + pure $ updRcm (flip delOneFromUniqDSet cl) rcm' --------------------------------------------------- -- * Instantiating constructors, types and evidence @@ -492,7 +534,7 @@ tyOracle (TySt inert) cts -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. Doesn't bother calling out to the type oracle if the bag of new type --- constraints was empty. Will only recheck 'PossibleMatches' in the term oracle +-- constraints was empty. Will only recheck 'ResidualCompleteMatches' in the term oracle -- for emptiness if the first argument is 'True'. tyIsSatisfiable :: Bool -> Bag PredType -> SatisfiabilityCheck tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \nabla -> @@ -544,10 +586,10 @@ of a PatSynCon (Just42,[]), this solution is incomparable to both Nothing and Just. Hence we retain the info in vi_neg, which eventually allows us to detect the complete pattern match. -The Pos/Neg invariant extends to vi_cache, which stores essentially positive -information. We make sure that vi_neg and vi_cache never overlap. This isn't -strictly necessary since vi_cache is just a cache, so doesn't need to be -accurate: Every suggestion of a possible ConLike from vi_cache might be +The Pos/Neg invariant extends to vi_rcm, which stores essentially positive +information. We make sure that vi_neg and vi_rcm never overlap. This isn't +strictly necessary since vi_rcm is just a cache, so doesn't need to be +accurate: Every suggestion of a possible ConLike from vi_rcm might be refutable by the type oracle anyway. But it helps to maintain sanity while debugging traces. @@ -568,7 +610,7 @@ The term oracle state is never obviously (i.e., without consulting the type oracle) contradictory. This implies a few invariants: * Whenever vi_pos overlaps with vi_neg according to 'eqPmAltCon', we refute. This is implied by the Note [Pos/Neg invariant]. -* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_cache to +* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_rcm to detect this, but we could just compare whole COMPLETE sets to vi_neg every time, if it weren't for performance. @@ -624,13 +666,16 @@ tmIsSatisfiable new_tm_cs = SC $ \nabla -> runMaybeT $ foldlM addTmCt nabla new_ ----------------------- -- * Looking up VarInfo +emptyRCM :: ResidualCompleteMatches +emptyRCM = RCM Nothing Nothing + emptyVarInfo :: Id -> VarInfo -- We could initialise @bot@ to @Just False@ in case of an unlifted type here, -- but it's cleaner to let the user of the constraint solver take care of this. -- After all, there are also strict fields, the unliftedness of which isn't -- evident in the type. So treating unlifted types here would never be -- sufficient anyway. -emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot NoPM +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot emptyRCM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' @@ -656,85 +701,6 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of | isNewDataCon dc = Just y go _ = Nothing -initPossibleMatches :: TyState -> VarInfo -> DsM VarInfo -initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do - -- New evidence might lead to refined info on ty, in turn leading to discovery - -- of a COMPLETE set. - res <- pmTopNormaliseType ty_st ty - let ty' = normalisedSourceType res - case splitTyConApp_maybe ty' of - Nothing -> pure vi{ vi_ty = ty' } - Just (tc, [_]) - | tc == tYPETyCon - -- TYPE acts like an empty data type on the term-level (#14086), but - -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a - -- special case. - -> pure vi{ vi_ty = ty', vi_cache = PM (pure emptyUniqDSet) } - Just (tc, tc_args) -> do - -- See Note [COMPLETE sets on data families] - (tc_rep, tc_fam) <- case tyConFamInst_maybe tc of - Just (tc_fam, _) -> pure (tc, tc_fam) - Nothing -> do - env <- dsGetFamInstEnvs - let (tc_rep, _tc_rep_args, _co) = tcLookupDataFamInst env tc tc_args - pure (tc_rep, tc) - -- Note that the common case here is tc_rep == tc_fam - let mb_rdcs = map RealDataCon <$> tyConDataCons_maybe tc_rep - let rdcs = maybeToList mb_rdcs - -- NB: tc_fam, because COMPLETE sets are associated with the parent data - -- family TyCon - pragmas <- dsGetCompleteMatches tc_fam - let fams = mapM dsLookupConLike . completeMatchConLikes - pscs <- mapM fams pragmas - -- pprTrace "initPossibleMatches" (ppr ty $$ ppr ty' $$ ppr tc_rep <+> ppr tc_fam <+> ppr tc_args $$ ppr (rdcs ++ pscs)) (return ()) - case NonEmpty.nonEmpty (rdcs ++ pscs) of - Nothing -> pure vi{ vi_ty = ty' } -- Didn't find any COMPLETE sets - Just cs -> pure vi{ vi_ty = ty', vi_cache = PM (mkUniqDSet <$> cs) } -initPossibleMatches _ vi = pure vi - -{- Note [COMPLETE sets on data families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -User-defined COMPLETE sets involving data families are attached to the family -TyCon, whereas the built-in COMPLETE set is attached to a data family instance's -representation TyCon. This matters for COMPLETE sets involving both DataCons -and PatSyns (from #17207): - - data family T a - data family instance T () = A | B - pattern C = B - {-# COMPLETE A, C #-} - f :: T () -> () - f A = () - f C = () - -The match on A is actually wrapped in a CoPat, matching impedance between T () -and its representation TyCon, which we translate as - at x | let y = x |> co, A <- y@ in PmCheck. - -Which TyCon should we use for looking up the COMPLETE set? The representation -TyCon from the match on A would only reveal the built-in COMPLETE set, while the -data family TyCon would only give the user-defined one. But when initialising -the PossibleMatches for a given Type, we want to do so only once, because -merging different COMPLETE sets after the fact is very complicated and possibly -inefficient. - -So in fact, we just *drop* the coercion arising from the CoPat when handling -handling the constraint @y ~ x |> co@ in addCoreCt, just equating @y ~ x at . -We then handle the fallout in initPossibleMatches, which has to get a hand at -both the representation TyCon tc_rep and the parent data family TyCon tc_fam. -It considers three cases after having established that the Type is a TyConApp: - -1. The TyCon is a vanilla data type constructor -2. The TyCon is tc_rep -3. The TyCon is tc_fam - -1. is simple and subsumed by the handling of the other two. -We check for case 2. by 'tyConFamInst_maybe' and get the tc_fam out. -Otherwise (3.), we try to lookup the data family instance at that particular -type to get out the tc_rep. In case 1., this will just return the original -TyCon, so tc_rep = tc_fam afterwards. --} - ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -897,11 +863,7 @@ addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do - -- For good performance, it's important to initPossibleMatches here. - -- Otherwise we can't mark nalt as matched later on, incurring unnecessary - -- inhabitation tests for nalt. - vi@(VI _ pos neg _ pm) <- lift $ initPossibleMatches (nabla_ty_st nabla) - (lookupVarInfo ts x) + let vi@(VI _ pos neg _ rcm) = lookupVarInfo ts x -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt (cl, _tvs, _args) = eqPmAltCon cl nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -917,9 +879,11 @@ addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor vi2 <- case nalt of - PmAltConLike cl - -> ensureInhabited nabla vi1{ vi_cache = markMatched cl pm } - _ -> pure vi1 + PmAltConLike cl -> do + rcm' <- lift (markMatched cl rcm) + ensureInhabited nabla vi1{ vi_rcm = rcm' } + _ -> + pure vi1 pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } hasRequiredTheta :: PmAltCon -> Bool @@ -963,13 +927,15 @@ storing required arguments along with the PmAltConLike in 'vi_neg'. -- its result type. Rather easy for DataCons, but not so much for PatSynCons. -- See Note [Pattern synonym result type] in "GHC.Core.PatSyn". guessConLikeUnivTyArgsFromResTy :: FamInstEnvs -> Type -> ConLike -> Maybe [Type] -guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon _) = do +guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon dc) = do (tc, tc_args) <- splitTyConApp_maybe res_ty -- Consider data families: In case of a DataCon, we need to translate to -- the representation TyCon. For PatSyns, they are relative to the data -- family TyCon, so we don't need to translate them. - let (_, tc_args', _) = tcLookupDataFamInst env tc tc_args - Just tc_args' + let (rep_tc, tc_args', _) = tcLookupDataFamInst env tc tc_args + if rep_tc == dataConTyCon dc + then Just tc_args' + else Nothing guessConLikeUnivTyArgsFromResTy _ res_ty (PatSynCon ps) = do -- We are successful if we managed to instantiate *every* univ_tv of con. -- This is difficult and bound to fail in some cases, see @@ -998,7 +964,7 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do -- | Returns (Just vi) if at least one member of each ConLike in the COMPLETE -- set satisfies the oracle -- --- Internally uses and updates the ConLikeSets in vi_cache. +-- Internally uses and updates the ConLikeSets in vi_rcm. -- -- NB: Does /not/ filter each ConLikeSet with the oracle; members may -- remain that do not statisfy it. This lazy approach just @@ -1007,17 +973,31 @@ ensureInhabited :: Nabla -> VarInfo -> MaybeT DsM VarInfo ensureInhabited nabla vi = case vi_bot vi of MaybeBot -> pure vi -- The |-Bot rule from the paper IsBot -> pure vi - IsNotBot -> lift (initPossibleMatches (nabla_ty_st nabla) vi) >>= inst_complete_sets + IsNotBot -> lift (add_matches vi) >>= inst_complete_sets where + add_matches :: VarInfo -> DsM VarInfo + add_matches vi = do + res <- pmTopNormaliseType (nabla_ty_st nabla) (vi_ty vi) + rcm <- case reprTyCon_maybe (normalisedSourceType res) of + Just tc -> addTyConMatches tc (vi_rcm vi) + Nothing -> addCompleteMatches (vi_rcm vi) + pure vi{ vi_rcm = rcm } + + reprTyCon_maybe :: Type -> Maybe TyCon + reprTyCon_maybe ty = case splitTyConApp_maybe ty of + Nothing -> Nothing + Just (tc, _args) -> case tyConFamInst_maybe tc of + Nothing -> Just tc + Just (tc_fam, _) -> Just tc_fam + -- | This is the |-Inst rule from the paper (section 4.5). Tries to -- find an inhabitant in every complete set by instantiating with one their -- constructors. If there is any complete set where we can't find an -- inhabitant, the whole thing is uninhabited. inst_complete_sets :: VarInfo -> MaybeT DsM VarInfo - inst_complete_sets vi at VI{ vi_cache = NoPM } = pure vi - inst_complete_sets vi at VI{ vi_cache = PM ms } = do - ms <- traverse (\cs -> inst_complete_set vi cs (uniqDSetToList cs)) ms - pure vi{ vi_cache = PM ms } + inst_complete_sets vi at VI{ vi_rcm = rcm } = do + rcm' <- trvRcm (\cls -> inst_complete_set vi cls (uniqDSetToList cls)) rcm + pure vi{ vi_rcm = rcm' } inst_complete_set :: VarInfo -> ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet -- (inst_complete_set cs cls) iterates over cls, deleting from cs @@ -1052,7 +1032,7 @@ ensureInhabited nabla vi = case vi_bot vi of ] -- | Checks if every 'VarInfo' in the term oracle has still an inhabited --- 'vi_cache', considering the current type information in 'Nabla'. +-- 'vi_rcm', considering the current type information in 'Nabla'. -- This check is necessary after having matched on a GADT con to weed out -- impossible matches. ensureAllInhabited :: Nabla -> DsM (Maybe Nabla) @@ -1111,7 +1091,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- Do the same for negative info let add_refut nabla nalt = addNotConCt nabla y nalt nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) - -- vi_cache will be updated in addNotConCt, so we are good to + -- vi_rcm will be updated in addNotConCt, so we are good to -- go! pure nabla_neg @@ -1123,7 +1103,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do - let VI ty pos neg bot cache = lookupVarInfo ts x + let VI ty pos neg bot rcm = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -1142,7 +1122,8 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do MaybeT $ addPmCts nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = (alt, tvs, args):pos - let nabla_with bot = nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot cache)) reps} + let nabla_with bot = + nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot rcm)) reps} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -1574,7 +1555,7 @@ provideEvidence = go try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. try_instantiate x xs n nabla = do - (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) let build_newtype (x, nabla) (_ty, dc, arg_ty) = do y <- lift $ mkPmId arg_ty -- Newtypes don't have existentials (yet?!), so passing an empty @@ -1586,10 +1567,12 @@ provideEvidence = go Just (y, newty_nabla) -> do -- Pick a COMPLETE set and instantiate it (n at max). Take care of ⊥. let vi = lookupVarInfo (nabla_tm_st newty_nabla) y - vi <- initPossibleMatches (nabla_ty_st newty_nabla) vi - mb_cls <- pickMinimalCompleteSet newty_nabla (vi_cache vi) + rcm <- case splitTyConApp_maybe rep_ty of + Nothing -> pure (vi_rcm vi) + Just (tc, _) -> addTyConMatches tc (vi_rcm vi) + mb_cls <- pickMinimalCompleteSet rep_ty rcm case uniqDSetToList <$> mb_cls of - Just cls@(_:_) -> instantiate_cons y core_ty xs n newty_nabla cls + Just cls@(_:_) -> instantiate_cons y rep_ty xs n newty_nabla cls Just [] | vi_bot vi == IsNotBot -> pure [] -- Either ⊥ is still possible (think Void) or there are no COMPLETE -- sets available, so we can assume it's inhabited @@ -1631,13 +1614,15 @@ provideEvidence = go other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls pure (con_nablas ++ other_cons_nablas) -pickMinimalCompleteSet :: Nabla -> PossibleMatches -> DsM (Maybe ConLikeSet) -pickMinimalCompleteSet _ NoPM = pure Nothing --- TODO: First prune sets with type info in nabla. But this is good enough for --- now and less costly. See #17386. -pickMinimalCompleteSet _ (PM clss) = do - tracePm "pickMinimalCompleteSet" (ppr $ NonEmpty.toList clss) - pure (Just (minimumBy (comparing sizeUniqDSet) clss)) +pickMinimalCompleteSet :: Type -> ResidualCompleteMatches -> DsM (Maybe ConLikeSet) +pickMinimalCompleteSet ty rcm = do + env <- dsGetFamInstEnvs + pure $ case filter (all (is_valid env) . uniqDSetToList) (getRcm rcm) of + [] -> Nothing + clss' -> Just (minimumBy (comparing sizeUniqDSet) clss') + where + is_valid :: FamInstEnvs -> ConLike -> Bool + is_valid env cl = isJust (guessConLikeUnivTyArgsFromResTy env ty cl) -- | Finds a representant of the semantic equality class of the given @e at . -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -24,8 +24,8 @@ module GHC.HsToCore.PmCheck.Types ( literalToPmLit, negatePmLit, overloadPmLit, pmLitAsStringLit, coreExprAsPmLit, - -- * Caching partially matched COMPLETE sets - ConLikeSet, PossibleMatches(..), + -- * Caching residual COMPLETE sets + ConLikeSet, ResidualCompleteMatches(..), getRcm, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -69,10 +69,10 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) import Data.Foldable (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ratio import qualified Data.Semigroup as Semi @@ -415,21 +415,31 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show -type ConLikeSet = UniqDSet ConLike +-- | A data type that caches for the 'VarInfo' of @x@ the results of querying +-- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for +-- which we already know @x /~ K@ from these sets. +-- +-- For motivation, see Section 5.3 in Lower Your Guards. +data ResidualCompleteMatches + = RCM + { rcm_vanilla :: !(Maybe ConLikeSet) + -- ^ The residual set for the vanilla COMPLETE set from the data defn. + -- Tracked separately from 'rcm_pragmas', because it might only be + -- known much later (when we have enough type information to see the 'TyCon' + -- of the match), or not at all even. Until that happens, it is 'Nothing'. + , rcm_pragmas :: !(Maybe [ConLikeSet]) + -- ^ The residual sets for /all/ COMPLETE sets from pragmas that are + -- visible when compiling this module. Querying that set with + -- 'dsGetCompleteMatches' requires 'DsM', so we initialise it with 'Nothing' + -- until first needed in a 'DsM' context. + } --- | A data type caching the results of 'completeMatchConLikes' with support for --- deletion of constructors that were already matched on. -data PossibleMatches - = PM (NonEmpty.NonEmpty ConLikeSet) - -- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE set - -- 'NonEmpty' because the empty case would mean that the type has no COMPLETE - -- set at all, for which we have 'NoPM'. - | NoPM - -- ^ No COMPLETE set for this type (yet). Think of overloaded literals. +getRcm :: ResidualCompleteMatches -> [ConLikeSet] +getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas -instance Outputable PossibleMatches where - ppr (PM cs) = ppr (NonEmpty.toList cs) - ppr NoPM = text "" +instance Outputable ResidualCompleteMatches where + -- formats as "[{Nothing,Just},{P,Q}]" + ppr rcm = ppr (getRcm rcm) -- | Either @Indirect x@, meaning the value is represented by that of @x@, or -- an @Entry@ containing containing the actual value it represents. @@ -516,8 +526,8 @@ data TmState -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". --- Also caches the type ('vi_ty'), the 'PossibleMatches' of a COMPLETE set --- ('vi_cache'). +-- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set +-- ('vi_rcm'). -- -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo @@ -559,7 +569,7 @@ data VarInfo -- * 'IsBot': @x ~ ⊥@ -- * 'IsNotBot': @x ≁ ⊥@ - , vi_cache :: !PossibleMatches + , vi_rcm :: !ResidualCompleteMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of -- possible constructors of each COMPLETE set. So, if it's not in here, we -- can't possibly match on it. Complementary to 'vi_neg'. We still need it ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -38,7 +38,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.IfaceToCore ( tcIfaceDecl, tcIfaceRules, tcIfaceInst, tcIfaceFamInst - , tcIfaceAnnotations, tcIfaceCompleteSigs ) + , tcIfaceAnnotations, tcIfaceCompleteMatches ) import GHC.Driver.Session import GHC.Driver.Backend @@ -479,7 +479,7 @@ loadInterface doc_str mod from ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) ; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface) ; new_eps_anns <- tcIfaceAnnotations (mi_anns iface) - ; new_eps_complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + ; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT", @@ -509,9 +509,7 @@ loadInterface doc_str mod from eps_rule_base = extendRuleBaseList (eps_rule_base eps) new_eps_rules, eps_complete_matches - = extendCompleteMatchMap - (eps_complete_matches eps) - new_eps_complete_sigs, + = eps_complete_matches eps ++ new_eps_complete_matches, eps_inst_env = extendInstEnvList (eps_inst_env eps) new_eps_insts, eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps) @@ -1037,9 +1035,8 @@ initExternalPackageState home_unit eps_fam_inst_env = emptyFamInstEnv, eps_rule_base = mkRuleBase builtinRules', -- Initialise the EPS rule pool with the built-in rules - eps_mod_fam_inst_env - = emptyModuleEnv, - eps_complete_matches = emptyUFM, + eps_mod_fam_inst_env = emptyModuleEnv, + eps_complete_matches = [], eps_ann_env = emptyAnnEnv, eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0 , n_insts_in = 0, n_insts_out = 0 @@ -1181,7 +1178,7 @@ pprModIface iface at ModIface{ mi_final_exts = exts } , ppr (mi_warns iface) , pprTrustInfo (mi_trust iface) , pprTrustPkg (mi_trust_pkg iface) - , vcat (map ppr (mi_complete_sigs iface)) + , vcat (map ppr (mi_complete_matches iface)) , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface)) , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface)) , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface)) ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -57,6 +57,7 @@ import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Name.Env import GHC.Types.Name.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Utils.Error import GHC.Utils.Outputable @@ -220,7 +221,7 @@ mkIface_ hsc_env md_anns = anns, md_types = type_env, md_exports = exports, - md_complete_sigs = complete_sigs } + md_complete_matches = complete_matches } -- NB: notice that mkIface does not look at the bindings -- only at the TypeEnv. The previous Tidy phase has -- put exactly the info into the TypeEnv that we want @@ -256,7 +257,7 @@ mkIface_ hsc_env iface_fam_insts = map famInstToIfaceFamInst fam_insts trust_info = setSafeMode safe_mode annotations = map mkIfaceAnnotation anns - icomplete_sigs = map mkIfaceCompleteSig complete_sigs + icomplete_matches = map mkIfaceCompleteMatch complete_matches ModIface { mi_module = this_mod, @@ -285,7 +286,7 @@ mkIface_ hsc_env mi_hpc = isHpcUsed hpc_info, mi_trust = trust_info, mi_trust_pkg = pkg_trust_req, - mi_complete_sigs = icomplete_sigs, + mi_complete_matches = icomplete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -322,8 +323,9 @@ mkIface_ hsc_env ************************************************************************ -} -mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch -mkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc +mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch +mkIfaceCompleteMatch cls = + IfaceCompleteMatch (map conLikeName (uniqDSetToList cls)) {- ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -324,11 +324,11 @@ data IfaceAnnotation type IfaceAnnTarget = AnnTarget OccName -data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName +newtype IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] instance Outputable IfaceCompleteMatch where - ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls - <+> dcolon <+> ppr ty + ppr (IfaceCompleteMatch cls) = text "COMPLETE" <> colon <+> ppr cls + @@ -2481,8 +2481,8 @@ instance Binary IfaceTyConParent where return $ IfDataInstance ax pr ty instance Binary IfaceCompleteMatch where - put_ bh (IfaceCompleteMatch cs ts) = put_ bh cs >> put_ bh ts - get bh = IfaceCompleteMatch <$> get bh <*> get bh + put_ bh (IfaceCompleteMatch cs) = put_ bh cs + get bh = IfaceCompleteMatch <$> get bh {- @@ -2638,7 +2638,7 @@ instance NFData IfaceConAlt where IfaceLitAlt lit -> lit `seq` () instance NFData IfaceCompleteMatch where - rnf (IfaceCompleteMatch f1 f2) = rnf f1 `seq` rnf f2 + rnf (IfaceCompleteMatch f1) = rnf f1 instance NFData IfaceRule where rnf (IfaceRule f1 f2 f3 f4 f5 f6 f7 f8) = ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -142,7 +142,7 @@ mkBootModDetailsTc hsc_env tcg_patsyns = pat_syns, tcg_insts = insts, tcg_fam_insts = fam_insts, - tcg_complete_matches = complete_sigs, + tcg_complete_matches = complete_matches, tcg_mod = this_mod } = -- This timing isn't terribly useful since the result isn't forced, but @@ -150,13 +150,13 @@ mkBootModDetailsTc hsc_env Err.withTiming dflags (text "CoreTidy"<+>brackets (ppr this_mod)) (const ()) $ - return (ModDetails { md_types = type_env' - , md_insts = insts' - , md_fam_insts = fam_insts - , md_rules = [] - , md_anns = [] - , md_exports = exports - , md_complete_sigs = complete_sigs + return (ModDetails { md_types = type_env' + , md_insts = insts' + , md_fam_insts = fam_insts + , md_rules = [] + , md_anns = [] + , md_exports = exports + , md_complete_matches = complete_matches }) where dflags = hsc_dflags hsc_env @@ -345,22 +345,22 @@ three places this is actioned: -} tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails) -tidyProgram hsc_env (ModGuts { mg_module = mod - , mg_exports = exports - , mg_rdr_env = rdr_env - , mg_tcs = tcs - , mg_insts = cls_insts - , mg_fam_insts = fam_insts - , mg_binds = binds - , mg_patsyns = patsyns - , mg_rules = imp_rules - , mg_anns = anns - , mg_complete_sigs = complete_sigs - , mg_deps = deps - , mg_foreign = foreign_stubs - , mg_foreign_files = foreign_files - , mg_hpc_info = hpc_info - , mg_modBreaks = modBreaks +tidyProgram hsc_env (ModGuts { mg_module = mod + , mg_exports = exports + , mg_rdr_env = rdr_env + , mg_tcs = tcs + , mg_insts = cls_insts + , mg_fam_insts = fam_insts + , mg_binds = binds + , mg_patsyns = patsyns + , mg_rules = imp_rules + , mg_anns = anns + , mg_complete_matches = complete_matches + , mg_deps = deps + , mg_foreign = foreign_stubs + , mg_foreign_files = foreign_files + , mg_hpc_info = hpc_info + , mg_modBreaks = modBreaks }) = Err.withTiming dflags @@ -465,13 +465,13 @@ tidyProgram hsc_env (ModGuts { mg_module = mod cg_modBreaks = modBreaks, cg_spt_entries = spt_entries }, - ModDetails { md_types = tidy_type_env, - md_rules = tidy_rules, - md_insts = tidy_cls_insts, - md_fam_insts = fam_insts, - md_exports = exports, - md_anns = anns, -- are already tidy - md_complete_sigs = complete_sigs + ModDetails { md_types = tidy_type_env, + md_rules = tidy_rules, + md_insts = tidy_cls_insts, + md_fam_insts = fam_insts, + md_exports = exports, + md_anns = anns, -- are already tidy + md_complete_matches = complete_matches }) } where ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -17,7 +17,7 @@ module GHC.IfaceToCore ( typecheckIfacesForMerging, typecheckIfaceForInstantiate, tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, - tcIfaceAnnotations, tcIfaceCompleteSigs, + tcIfaceAnnotations, tcIfaceCompleteMatches, tcIfaceExpr, -- Desired by HERMIT (#7683) tcIfaceGlobal, tcIfaceOneShot @@ -67,6 +67,7 @@ import GHC.Types.Name.Set import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Unit.Module import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet ( mkUniqDSet ) import GHC.Types.Unique.Supply import GHC.Utils.Outputable import GHC.Data.Maybe @@ -180,7 +181,7 @@ typecheckIface iface ; exports <- ifaceExportNames (mi_exports iface) -- Complete Sigs - ; complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + ; complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) -- Finished ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface), @@ -194,7 +195,7 @@ typecheckIface iface , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } } @@ -393,14 +394,14 @@ typecheckIfacesForMerging mod ifaces tc_env_var = rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) exports <- ifaceExportNames (mi_exports iface) - complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) return $ ModDetails { md_types = type_env , md_insts = insts , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } return (global_type_env, details) @@ -432,14 +433,14 @@ typecheckIfaceForInstantiate nsubst iface = rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) exports <- ifaceExportNames (mi_exports iface) - complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) return $ ModDetails { md_types = type_env , md_insts = insts , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } -- Note [Resolving never-exported Names] @@ -1147,11 +1148,14 @@ tcIfaceAnnTarget (ModuleTarget mod) = do ************************************************************************ -} -tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch] -tcIfaceCompleteSigs = mapM tcIfaceCompleteSig +tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch] +tcIfaceCompleteMatches = mapM tcIfaceCompleteMatch -tcIfaceCompleteSig :: IfaceCompleteMatch -> IfL CompleteMatch -tcIfaceCompleteSig (IfaceCompleteMatch ms t) = return (CompleteMatch ms t) +tcIfaceCompleteMatch :: IfaceCompleteMatch -> IfL CompleteMatch +tcIfaceCompleteMatch (IfaceCompleteMatch ms) = + mkUniqDSet <$> mapM (forkM doc . tcIfaceConLike) ms + where + doc = text "COMPLETE sig" <+> ppr ms {- ************************************************************************ @@ -1760,7 +1764,13 @@ tcIfaceDataCon :: Name -> IfL DataCon tcIfaceDataCon name = do { thing <- tcIfaceGlobal name ; case thing of AConLike (RealDataCon dc) -> return dc - _ -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) } + _ -> pprPanic "tcIfaceDataCon" (ppr name$$ ppr thing) } + +tcIfaceConLike :: Name -> IfL ConLike +tcIfaceConLike name = do { thing <- tcIfaceGlobal name + ; case thing of + AConLike cl -> return cl + _ -> pprPanic "tcIfaceConLike" (ppr name$$ ppr thing) } tcIfaceExtId :: Name -> IfL Id tcIfaceExtId name = do { thing <- tcIfaceGlobal name ===================================== compiler/GHC/IfaceToCore.hs-boot ===================================== @@ -11,9 +11,9 @@ import GHC.Core ( CoreRule ) import GHC.Driver.Types ( CompleteMatch ) import GHC.Types.Annotations ( Annotation ) -tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing -tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] -tcIfaceInst :: IfaceClsInst -> IfL ClsInst -tcIfaceFamInst :: IfaceFamInst -> IfL FamInst -tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] -tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch] +tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing +tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] +tcIfaceInst :: IfaceClsInst -> IfL ClsInst +tcIfaceFamInst :: IfaceFamInst -> IfL FamInst +tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] +tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch] ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -44,9 +44,8 @@ import GHC.Tc.Utils.TcMType import GHC.Core.Multiplicity import GHC.Core.FamInstEnv( normaliseType ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs ) -import GHC.Core.TyCon import GHC.Tc.Utils.TcType -import GHC.Core.Type (mkStrLitTy, tidyOpenType, splitTyConApp_maybe, mkCastTy) +import GHC.Core.Type (mkStrLitTy, tidyOpenType, mkCastTy) import GHC.Builtin.Types.Prim import GHC.Builtin.Types( mkBoxedTupleTy ) import GHC.Types.Id @@ -69,9 +68,9 @@ import GHC.Utils.Panic import GHC.Builtin.Names( ipClassName ) import GHC.Tc.Validity (checkValidType) import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Unique.Set import qualified GHC.LanguageExtensions as LangExt -import GHC.Core.ConLike import Control.Monad import Data.Foldable (find) @@ -197,112 +196,22 @@ tcTopBinds binds sigs -- The top level bindings are flattened into a giant -- implicitly-mutually-recursive LHsBinds - --- Note [Typechecking Complete Matches] --- Much like when a user bundled a pattern synonym, the result types of --- all the constructors in the match pragma must be consistent. --- --- If we allowed pragmas with inconsistent types then it would be --- impossible to ever match every constructor in the list and so --- the pragma would be useless. - - - - - --- This is only used in `tcCompleteSig`. We fold over all the conlikes, --- this accumulator keeps track of the first `ConLike` with a concrete --- return type. After fixing the return type, all other constructors with --- a fixed return type must agree with this. --- --- The fields of `Fixed` cache the first conlike and its return type so --- that we can compare all the other conlikes to it. The conlike is --- stored for error messages. --- --- `Nothing` in the case that the type is fixed by a type signature -data CompleteSigType = AcceptAny | Fixed (Maybe ConLike) TyCon - tcCompleteSigs :: [LSig GhcRn] -> TcM [CompleteMatch] tcCompleteSigs sigs = let - doOne :: Sig GhcRn -> TcM (Maybe CompleteMatch) - doOne c@(CompleteMatchSig _ _ lns mtc) - = fmap Just $ do - addErrCtxt (text "In" <+> ppr c) $ - case mtc of - Nothing -> infer_complete_match - Just tc -> check_complete_match tc - where - - checkCLTypes acc = foldM checkCLType (acc, []) (unLoc lns) - - infer_complete_match = do - (res, cls) <- checkCLTypes AcceptAny - case res of - AcceptAny -> failWithTc ambiguousError - Fixed _ tc -> return $ mkMatch cls tc - - check_complete_match tc_name = do - ty_con <- tcLookupLocatedTyCon tc_name - (_, cls) <- checkCLTypes (Fixed Nothing ty_con) - return $ mkMatch cls ty_con - - mkMatch :: [ConLike] -> TyCon -> CompleteMatch - mkMatch cls ty_con = CompleteMatch { - -- foldM is a left-fold and will have accumulated the ConLikes in - -- the reverse order. foldrM would accumulate in the correct order, - -- but would type-check the last ConLike first, which might also be - -- confusing from the user's perspective. Hence reverse here. - completeMatchConLikes = reverse (map conLikeName cls), - completeMatchTyCon = tyConName ty_con - } + doOne :: LSig GhcRn -> TcM (Maybe CompleteMatch) + -- We don't need to "type-check" COMPLETE signatures anymore; if their + -- combinations are invalid it will be found so at match sites. Hence we + -- keep '_mtc' only for backwards compatibility. + doOne (L loc c@(CompleteMatchSig _ext _src_txt (L _ ns) _mtc)) + = fmap Just $ setSrcSpan loc $ addErrCtxt (text "In" <+> ppr c) $ + mkUniqDSet <$> mapM (addLocM tcLookupConLike) ns doOne _ = return Nothing - ambiguousError :: SDoc - ambiguousError = - text "A type signature must be provided for a set of polymorphic" - <+> text "pattern synonyms." - - - -- See note [Typechecking Complete Matches] - checkCLType :: (CompleteSigType, [ConLike]) -> Located Name - -> TcM (CompleteSigType, [ConLike]) - checkCLType (cst, cs) n = do - cl <- addLocM tcLookupConLike n - let (_,_,_,_,_,_, res_ty) = conLikeFullSig cl - res_ty_con = fst <$> splitTyConApp_maybe res_ty - case (cst, res_ty_con) of - (AcceptAny, Nothing) -> return (AcceptAny, cl:cs) - (AcceptAny, Just tc) -> return (Fixed (Just cl) tc, cl:cs) - (Fixed mfcl tc, Nothing) -> return (Fixed mfcl tc, cl:cs) - (Fixed mfcl tc, Just tc') -> - if tc == tc' - then return (Fixed mfcl tc, cl:cs) - else case mfcl of - Nothing -> - addErrCtxt (text "In" <+> ppr cl) $ - failWithTc typeSigErrMsg - Just cl -> failWithTc (errMsg cl) - where - typeSigErrMsg :: SDoc - typeSigErrMsg = - text "Couldn't match expected type" - <+> quotes (ppr tc) - <+> text "with" - <+> quotes (ppr tc') - - errMsg :: ConLike -> SDoc - errMsg fcl = - text "Cannot form a group of complete patterns from patterns" - <+> quotes (ppr fcl) <+> text "and" <+> quotes (ppr cl) - <+> text "as they match different type constructors" - <+> parens (quotes (ppr tc) - <+> text "resp." - <+> quotes (ppr tc')) -- For some reason I haven't investigated further, the signatures come in -- backwards wrt. declaration order. So we reverse them here, because it makes -- a difference for incomplete match suggestions. - in mapMaybeM (addLocM doOne) (reverse sigs) -- process in declaration order + in mapMaybeM doOne $ reverse sigs tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id] -- A hs-boot file has only one BindGroup, and it only has type ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -45,12 +45,11 @@ module GHC.Tc.Types( IdBindingInfo(..), ClosedTypeId, RhsNames, IsGroupClosed(..), SelfBootInfo(..), - pprTcTyThingCategory, pprPECategory, CompleteMatch(..), + pprTcTyThingCategory, pprPECategory, CompleteMatch, -- Desugaring types DsM, DsLclEnv(..), DsGblEnv(..), - DsMetaEnv, DsMetaVal(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap, + DsMetaEnv, DsMetaVal(..), CompleteMatches, -- Template Haskell ThStage(..), SpliceType(..), PendingStuff(..), @@ -310,7 +309,7 @@ data DsGblEnv , ds_msgs :: IORef Messages -- Warning messages , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, -- possibly-imported things - , ds_complete_matches :: CompleteMatchMap + , ds_complete_matches :: CompleteMatches -- Additional complete pattern matches , ds_cc_st :: IORef CostCentreState -- Tracking indices for cost centre annotations @@ -602,7 +601,7 @@ data TcGblEnv tcg_static_wc :: TcRef WantedConstraints, -- ^ Wanted constraints of static forms. -- See Note [Constraints in static forms]. - tcg_complete_matches :: [CompleteMatch], + tcg_complete_matches :: CompleteMatches, -- ^ Tracking indices for cost centre annotations tcg_cc_st :: TcRef CostCentreState ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -64,8 +64,8 @@ module GHC.Tc.Utils.Env( topIdLvl, isBrackStage, -- New Ids - newDFunName, newFamInstTyConName, - newFamInstAxiomName, + newDFunName, + newFamInstTyConName, newFamInstAxiomName, mkStableIdFromString, mkStableIdFromName, mkWrapperName ) where ===================================== docs/users_guide/exts/pragmas.rst ===================================== @@ -887,29 +887,6 @@ modules. ``COMPLETE`` pragmas should be thought of as asserting a universal truth about a set of patterns and as a result, should not be used to silence context specific incomplete match warnings. -When specifying a ``COMPLETE`` pragma, the result types of all patterns must -be consistent with each other. This is a sanity check as it would be impossible -to match on all the patterns if the types were inconsistent. - -The result type must also be unambiguous. Usually this can be inferred but -when all the pattern synonyms in a group are polymorphic in the constructor -the user must provide a type signature. :: - - class LL f where - go :: f a -> () - - instance LL [] where - go _ = () - - pattern T :: LL f => f a - pattern T <- (go -> ()) - - {-# COMPLETE T :: [] #-} - - -- No warning - foo :: [a] -> Int - foo T = 5 - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/pmcheck/complete_sigs/completesig15.hs → testsuite/tests/pmcheck/complete_sigs/T14422.hs ===================================== @@ -10,3 +10,6 @@ pattern P :: C f => f a pattern P <- (foo -> ()) {-# COMPLETE P #-} + +f :: C f => f a -> () +f P = () -- A complete match ===================================== testsuite/tests/pmcheck/complete_sigs/T18277.hs ===================================== @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +type List = [] + +pattern DefinitelyAString :: String -> String +pattern DefinitelyAString x = x +{-# COMPLETE DefinitelyAString #-} + +f :: String -> String +f (DefinitelyAString x) = x ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -1,7 +1,7 @@ test('completesig01', normal, compile, ['']) test('completesig02', normal, compile, ['']) test('Completesig03', normal, multimod_compile, ['Completesig03', '-Wall']) -test('completesig04', normal, compile_fail, ['']) +test('completesig04', normal, compile, ['-Wincomplete-patterns']) test('completesig05', normal, compile, ['']) test('completesig06', normal, compile, ['']) test('completesig07', normal, compile, ['']) @@ -12,7 +12,6 @@ test('completesig11', normal, compile, ['']) test('completesig12', normal, compile, ['']) test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) -test('completesig15', normal, compile_fail, ['']) test('T13021', normal, compile, ['']) test('T13363a', normal, compile, ['']) test('T13363b', normal, compile, ['']) @@ -22,6 +21,8 @@ test('T13965', normal, compile, ['']) test('T14059a', normal, compile, ['']) test('T14059b', expect_broken('14059'), compile, ['']) test('T14253', normal, compile, ['']) +test('T14422', normal, compile, ['']) test('T14851', normal, compile, ['']) test('T17149', normal, compile, ['']) test('T17386', normal, compile, ['']) +test('T18277', normal, compile, ['']) ===================================== testsuite/tests/pmcheck/complete_sigs/completesig04.hs ===================================== @@ -1,6 +1,12 @@ --- Test that a COMPLETE pragma over constructors of different types fails. +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +-- Test that a COMPLETE pragma over constructors of different types is a valid +-- declaration, but that it's not suggested in any warning. module TyMismatch where -data E = L | R +data T = A | B | C -{-# COMPLETE Just, L #-} +{-# COMPLETE Just, A #-} + +f A = () -- should not suggest 'Just' + +g (Just _) = () -- should not suggest 'A' ===================================== testsuite/tests/pmcheck/complete_sigs/completesig04.stderr ===================================== @@ -1,4 +1,11 @@ -completesig04.hs:6:1: error: - • Cannot form a group of complete patterns from patterns ‘Just’ and ‘L’ as they match different type constructors (‘Maybe’ resp. ‘E’) - • In {-# COMPLETE Just, L #-} +completesig04.hs:10:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: + Patterns not matched: + B + C + +completesig04.hs:12:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘g’: Patterns not matched: Nothing ===================================== testsuite/tests/pmcheck/complete_sigs/completesig15.stderr deleted ===================================== @@ -1,4 +0,0 @@ - -completesig15.hs:12:1: error: - • A type signature must be provided for a set of polymorphic pattern synonyms. - • In {-# COMPLETE P #-} ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -88,7 +88,7 @@ test('T17112', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17207', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17207b', expect_broken(17207), compile, +test('T17207b', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17208', expect_broken(17208), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b9cfcc66a605425a04d39bb6849350b7b362b1d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b9cfcc66a605425a04d39bb6849350b7b362b1d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 19:16:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Sep 2020 15:16:55 -0400 Subject: [Git][ghc/ghc][wip/happy-1.20] ci.sh: Enforce minimum happy/alex versions Message-ID: <5f4fefa73436f_80b3f849cad51a0103104b5@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/happy-1.20 at Glasgow Haskell Compiler / GHC Commits: 02b64756 by Ben Gamari at 2020-09-02T15:16:47-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -7,6 +7,8 @@ set -e -o pipefail # Configuration: hackage_index_state="2020-08-25T12:30:13Z" +MIN_HAPPY_VERSION="1.20" +MIN_ALEX_VERSION="3.2" # Colors BLACK="0;30" @@ -256,17 +258,13 @@ function setup_toolchain() { *) ;; esac - if [ ! -e "$HAPPY" ]; then - info "Building happy..." - cabal update - $cabal_install happy - fi + cabal update - if [ ! -e "$ALEX" ]; then - info "Building alex..." - cabal update - $cabal_install alex - fi + info "Building happy..." + $cabal_install "happy>=$MIN_HAPPY_VERSION" + + info "Building alex..." + $cabal_install "alex>=$MIN_ALEX_VERSION" } function cleanup_submodules() { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02b6475632d37b8b6ca0a4628248edcf498bdbfd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/02b6475632d37b8b6ca0a4628248edcf498bdbfd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 19:28:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Sep 2020 15:28:03 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports Message-ID: <5f4ff243a3182_80b3f840a9dbe44103129b5@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 19:54:27 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 02 Sep 2020 15:54:27 -0400 Subject: [Git][ghc/ghc][master] testsuite: Add broken test for #18302 Message-ID: <5f4ff87314eb2_80b3f848c268e001031863c@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - 3 changed files: - + testsuite/tests/rename/should_compile/T18302A.hs - + testsuite/tests/rename/should_compile/T18302B.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== testsuite/tests/rename/should_compile/T18302A.hs ===================================== @@ -0,0 +1,4 @@ +module T18302A ( module GHC.Prim ) where + +import GHC.Prim + ===================================== testsuite/tests/rename/should_compile/T18302B.hs ===================================== @@ -0,0 +1,8 @@ +-- | Check that TYPE and (->) are re-exportable. +module T18302B where + +import T18302A + +type T = TYPE +type F = (->) + ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -176,3 +176,4 @@ test('T17832', [], multimod_compile, ['T17832M1', 'T17832M2']) test('T17837', normal, compile, ['']) test('T18497', [], makefile_test, ['T18497']) test('T18264', [], makefile_test, ['T18264']) +test('T18302', expect_broken(18302), compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4edcde70160820dd23c53d9019f895930e2c0e7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b4edcde70160820dd23c53d9019f895930e2c0e7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 19:55:02 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 02 Sep 2020 15:55:02 -0400 Subject: [Git][ghc/ghc][master] Turn on -XMonoLocalBinds by default (#18430) Message-ID: <5f4ff8966cfdf_80b3f8476b38e6010321778@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - 7 changed files: - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/SysTools.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/CmmToAsm/Reg/Linear.hs ===================================== @@ -205,7 +205,7 @@ regAlloc _ (CmmProc _ _ _ _) -- an entry in the block map or it is the first block. -- linearRegAlloc - :: Instruction instr + :: forall instr. Instruction instr => NCGConfig -> [BlockId] -- ^ entry points -> BlockMap RegSet @@ -231,6 +231,8 @@ linearRegAlloc config entry_ids block_live sccs ArchJavaScript -> panic "linearRegAlloc ArchJavaScript" ArchUnknown -> panic "linearRegAlloc ArchUnknown" where + go :: (FR regs, Outputable regs) + => regs -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int) go f = linearRegAlloc' config f entry_ids block_live sccs platform = ncgPlatform config @@ -973,4 +975,3 @@ loadTemp vreg (ReadMem slot) hreg spills loadTemp _ _ _ spills = return spills - ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2290,6 +2290,7 @@ lintCoercion this@(AxiomRuleCo ax cos) Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] Just _ -> return (AxiomRuleCo ax cos') } where + err :: forall a. String -> [SDoc] -> LintM a err m xs = failWithL $ hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -1909,7 +1909,7 @@ completeCall env var cont log_inlining $ sep [text "Inlining done:", nest 4 (ppr var)] | otherwise - = liftIO $ log_inlining $ + = log_inlining $ sep [text "Inlining done: " <> ppr var, nest 4 (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding), text "Cont: " <+> ppr cont])] ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -1373,7 +1373,8 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup -- -- There better had not be any cyclic groups here -- we check for them. upsweep - :: GhcMonad m + :: forall m + . GhcMonad m => Maybe Messager -> HomePackageTable -- ^ HPT from last time round (pruned) -> StableModules -- ^ stable modules (see checkStability) @@ -1415,8 +1416,7 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do return (Failed, done') upsweep' - :: GhcMonad m - => HomePackageTable + :: HomePackageTable -> ModuleGraph -> [SCC ModSummary] -> Int ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -1134,6 +1134,7 @@ unload_wkr hsc_env keep_linkables pls at PersistentLinkerState{..} = do -- Note that we want to remove all *local* -- (i.e. non-isExternal) names too (these are the -- temporary bindings from the command line). + keep_name :: (Name, a) -> Bool keep_name (n,_) = isExternalName n && nameModule n `elemModuleSet` bcos_retained ===================================== compiler/GHC/SysTools.hs ===================================== @@ -138,15 +138,17 @@ lazyInitLlvmConfig :: String -> IO LlvmConfig lazyInitLlvmConfig top_dir = unsafeInterleaveIO $ do -- see Note [LLVM configuration] - targets <- readAndParse "llvm-targets" mkLlvmTarget - passes <- readAndParse "llvm-passes" id - return $ LlvmConfig { llvmTargets = targets, llvmPasses = passes } + targets <- readAndParse "llvm-targets" + passes <- readAndParse "llvm-passes" + return $ LlvmConfig { llvmTargets = fmap mkLlvmTarget <$> targets, + llvmPasses = passes } where - readAndParse name builder = + readAndParse :: Read a => String -> IO a + readAndParse name = do let llvmConfigFile = top_dir name llvmConfigStr <- readFile llvmConfigFile case maybeReadFuzzy llvmConfigStr of - Just s -> return (fmap builder <$> s) + Just s -> return s Nothing -> pgmError ("Can't parse " ++ show llvmConfigFile) mkLlvmTarget :: (String, String, String) -> LlvmTarget ===================================== compiler/ghc.cabal.in ===================================== @@ -153,6 +153,7 @@ Library NoImplicitPrelude ,BangPatterns ,ScopedTypeVariables + ,MonoLocalBinds Exposed-Modules: GHC.Iface.Ext.Types View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfab2a30be5cc68e7914c3f6bb9ae4ad33283ffc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bfab2a30be5cc68e7914c3f6bb9ae4ad33283ffc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 19:55:37 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 02 Sep 2020 15:55:37 -0400 Subject: [Git][ghc/ghc][master] Remove potential space leak from Data.List.transpose Message-ID: <5f4ff8b938611_80b3f83f205b50810324067@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - 1 changed file: - libraries/base/Data/OldList.hs Changes: ===================================== libraries/base/Data/OldList.hs ===================================== @@ -550,7 +550,13 @@ intercalate xs xss = concat (intersperse xs xss) transpose :: [[a]] -> [[a]] transpose [] = [] transpose ([] : xss) = transpose xss -transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss]) +transpose ((x:xs) : xss) = (x : hds) : transpose (xs : tls) + where + -- We tie the calculations of heads and tails together + -- to prevent heads from leaking into tails and vice versa. + -- unzip makes the selector thunk arrangements we need to + -- ensure everything gets cleaned up properly. + (hds, tls) = unzip [(hd, tl) | (hd:tl) <- xss] -- | The 'partition' function takes a predicate a list and returns View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c30cc0e9c3704b24ad0f6d9a0199bf8b5835bd40 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c30cc0e9c3704b24ad0f6d9a0199bf8b5835bd40 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 19:56:16 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 02 Sep 2020 15:56:16 -0400 Subject: [Git][ghc/ghc][master] Remove outdated note Message-ID: <5f4ff8e0d4bcc_80b3f84956bc0ac10326485@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 1 changed file: - compiler/GHC/Builtin/Names.hs Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -116,35 +116,6 @@ known keys. See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys) in GHC.Builtin.Types. -Note [The integer library] -~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Clearly, we need to know the names of various definitions of the integer -library, e.g. the type itself, `mkInteger` etc. But there are two possible -implementations of the integer library: - - * integer-gmp (fast, but uses libgmp, which may not be available on all - targets and is GPL licensed) - * integer-simple (slow, but pure Haskell and BSD-licensed) - -We want the compiler to work with either one. The way we achieve this is: - - * When compiling the integer-{gmp,simple} library, we pass - -this-unit-id integer-wired-in - to GHC (see the cabal file libraries/integer-{gmp,simple}. - * This way, GHC can use just this UnitID (see Module.integerUnitId) when - generating code, and the linker will succeed. - -Unfortuately, the abstraction is not complete: When using integer-gmp, we -really want to use the S# constructor directly. This is controlled by -the `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use -this constructor directly (see CorePrep.lookupIntegerSDataConName) - -When GHC reads the package data base, it (internally only) pretends it has UnitId -`integer-wired-in` instead of the actual UnitId (which includes the version -number); just like for `base` and other packages, as described in -Note [Wired-in units] in GHC.Unit.Module. This is done in -GHC.Unit.State.findWiredInUnits. -} {-# LANGUAGE CPP #-} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffc3da474bd6febf8a120ebd432ad69f92fe03e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffc3da474bd6febf8a120ebd432ad69f92fe03e0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 19:56:56 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 02 Sep 2020 15:56:56 -0400 Subject: [Git][ghc/ghc][master] Bignum: add missing compat import/export functions Message-ID: <5f4ff9082c25_80b3f83f205b5081032981d@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 1 changed file: - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs Changes: ===================================== libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs ===================================== @@ -57,9 +57,6 @@ module GHC.Integer.GMP.Internals , bigNatToInt , bigNatToWord , indexBigNat# - , importBigNatFromByteArray - , exportBigNatToMutableByteArray - -- ** 'BigNat' arithmetic operations , plusBigNat @@ -112,9 +109,17 @@ module GHC.Integer.GMP.Internals -- ** Export , exportBigNatToAddr + , exportIntegerToAddr + + , exportBigNatToMutableByteArray + , exportIntegerToMutableByteArray -- ** Import , importBigNatFromAddr + , importIntegerFromAddr + + , importBigNatFromByteArray + , importIntegerFromByteArray ) where import GHC.Integer @@ -373,6 +378,18 @@ exportBigNatToAddr (BN# b) addr endian = IO \s -> case B.bigNatToAddr# b addr endian s of (# s', w #) -> (# s', W# w #) +{-# DEPRECATED importIntegerFromAddr "Use integerFromAddr# instead" #-} +importIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer +importIntegerFromAddr addr sz endian = IO \s -> + case I.integerFromAddr# sz addr endian s of + (# s', i #) -> (# s', i #) + +{-# DEPRECATED exportIntegerToAddr "Use integerToAddr# instead" #-} +exportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word +exportIntegerToAddr i addr endian = IO \s -> + case I.integerToAddr# i addr endian s of + (# s', w #) -> (# s', W# w #) + wordToBigNat :: Word# -> BigNat wordToBigNat w = BN# (B.bigNatFromWord# w) @@ -398,3 +415,13 @@ importBigNatFromByteArray ba off sz endian = case runRW# (B.bigNatFromByteArray# exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word exportBigNatToMutableByteArray (BN# ba) mba off endian = IO (\s -> case B.bigNatToMutableByteArray# ba mba off endian s of (# s', r #) -> (# s', W# r #)) + +{-# DEPRECATED importIntegerFromByteArray "Use integerFromByteArray# instead" #-} +importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer +importIntegerFromByteArray ba off sz endian = case runRW# (I.integerFromByteArray# sz ba off endian) of + (# _, r #) -> r + +{-# DEPRECATED exportIntegerToMutableByteArray "Use integerToMutableByteArray# instead" #-} +exportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word +exportIntegerToMutableByteArray i mba off endian = IO (\s -> case I.integerToMutableByteArray# i mba off endian s of + (# s', r #) -> (# s', W# r #)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85e621234916e9b5d40174831a3b422bd99f8f83 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/85e621234916e9b5d40174831a3b422bd99f8f83 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 21:46:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Sep 2020 17:46:47 -0400 Subject: [Git][ghc/ghc][wip/happy-1.20] ci.sh: Enforce minimum happy/alex versions Message-ID: <5f5012c7a35e6_80b3f84a02c194c10332846@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/happy-1.20 at Glasgow Haskell Compiler / GHC Commits: 84f48794 by Ben Gamari at 2020-09-02T17:46:33-04:00 ci.sh: Enforce minimum happy/alex versions Also, always invoke cabal-install to ensure that happy/alex symlinks are up-to-date. - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -7,6 +7,8 @@ set -e -o pipefail # Configuration: hackage_index_state="2020-08-25T12:30:13Z" +MIN_HAPPY_VERSION="1.20" +MIN_ALEX_VERSION="3.2" # Colors BLACK="0;30" @@ -256,17 +258,13 @@ function setup_toolchain() { *) ;; esac - if [ ! -e "$HAPPY" ]; then - info "Building happy..." - cabal update - $cabal_install happy - fi + cabal update - if [ ! -e "$ALEX" ]; then - info "Building alex..." - cabal update - $cabal_install alex - fi + info "Building happy..." + $cabal_install happy --constraint="happy>=$MIN_HAPPY_VERSION" + + info "Building alex..." + $cabal_install alex --constraint="alex>=$MIN_ALEX_VERSION" } function cleanup_submodules() { View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84f4879416b5d27b110d5abb58f8a692e6a92d7a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84f4879416b5d27b110d5abb58f8a692e6a92d7a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 22:23:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Sep 2020 18:23:01 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/fix-makeindex Message-ID: <5f501b456df36_80bda26b08103335d@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/fix-makeindex at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/fix-makeindex You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 22:23:29 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Sep 2020 18:23:29 -0400 Subject: [Git][ghc/ghc][wip/T18550] WIP Message-ID: <5f501b615abeb_80b3f846a62aefc103351f1@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18550 at Glasgow Haskell Compiler / GHC Commits: bf8c2e2f by Ben Gamari at 2020-08-17T10:29:20-04:00 WIP - - - - - 5 changed files: - aclocal.m4 - configure.ac - hadrian/cfg/system.config.in - mk/config.mk.in - rules/build-package-way.mk Changes: ===================================== aclocal.m4 ===================================== @@ -2635,6 +2635,7 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ # ------------------ # Find which linker to use to merge object files. # +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_REQUIRE([FIND_LD]) @@ -2655,6 +2656,9 @@ AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the MergeObjsCmd variable to a functional linker.]) fi fi + + AC_SUBST([MergeObjsCmd]) + AC_SUBST([MergeObjsArgs]) ]) # FIND_PYTHON ===================================== configure.ac ===================================== @@ -448,6 +448,8 @@ then NM="${mingwbin}nm.exe" RANLIB="${mingwbin}ranlib.exe" OBJDUMP="${mingwbin}objdump.exe" + MergeObjsCmd="$LD" + MergeObjsArgs="-r --oformat=pe-bigobj-x86-64" fp_prog_ar="${mingwbin}ar.exe" AC_PATH_PROG([Genlib],[genlib]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -14,6 +14,7 @@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ nm = @NmCmd@ +merge-objs = @MergeObjsCmd@ objdump = @ObjdumpCmd@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ @@ -115,10 +116,10 @@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ -conf-merge-objects-args-stage0 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage1 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage2 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage3 = @SettingsMergeObjectsFlags@ +conf-merge-objects-args-stage0 = @MergeObjsArgs@ +conf-merge-objects-args-stage1 = @MergeObjsArgs@ +conf-merge-objects-args-stage2 = @MergeObjsArgs@ +conf-merge-objects-args-stage3 = @MergeObjsArgs@ # Settings: ===================================== mk/config.mk.in ===================================== @@ -544,6 +544,16 @@ LD_STAGE1 = $(LD) LD_STAGE2 = $(LD) LD_STAGE3 = $(LD) +MERGE_OBJS_STAGE0 = @MergeObjsCmd@ +MERGE_OBJS_STAGE1 = @MergeObjsCmd@ +MERGE_OBJS_STAGE2 = @MergeObjsCmd@ +MERGE_OBJS_STAGE3 = @MergeObjsCmd@ + +MERGE_OBJS_STAGE0_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE1_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE2_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE3_FLAGS = @MergeObjsArgs@ + # Cross-compiling options # See Note [CrossCompiling vs Stage1Only] CrossCompiling = @CrossCompiling@ ===================================== rules/build-package-way.mk ===================================== @@ -107,6 +107,7 @@ endif endif # Build the GHCi library +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. ifneq "$(filter $3, v p)" "" $1_$2_$3_GHCI_LIB = $1/$2/build/HS$$($1_$2_COMPONENT_ID).$$($3_osuf) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" @@ -116,7 +117,7 @@ BINDIST_LIBS += $$($1_$2_$3_GHCI_LIB) endif endif $$($1_$2_$3_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) $$($1_$2_LD_SCRIPT) - $$(call cmd,SettingsMergeObjectsCommand) $(SettingsMergeObjectsFlags) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) + $$(call cmd,MERGE_OBJS_STAGE$4) $(MERGE_OBJS_STAGE$4_FLAGS) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" # Don't bother making ghci libs for bootstrapping packages ifneq "$4" "0" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf8c2e2fde7719edc28225164b21413026ab09b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf8c2e2fde7719edc28225164b21413026ab09b3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 22:45:24 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Wed, 02 Sep 2020 18:45:24 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18644 Message-ID: <5f5020849ae65_80b3f84696e1f90103384aa@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T18644 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18644 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 2 23:37:24 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Sep 2020 19:37:24 -0400 Subject: [Git][ghc/ghc][wip/T18550] WIP Message-ID: <5f502cb4d9cac_80bd7dcb7c10342727@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18550 at Glasgow Haskell Compiler / GHC Commits: ceb73fbc by Ben Gamari at 2020-09-02T19:37:17-04:00 WIP - - - - - 6 changed files: - aclocal.m4 - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - mk/config.mk.in - rules/build-package-way.mk Changes: ===================================== aclocal.m4 ===================================== @@ -2635,6 +2635,7 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ # ------------------ # Find which linker to use to merge object files. # +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_REQUIRE([FIND_LD]) @@ -2655,6 +2656,9 @@ AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the MergeObjsCmd variable to a functional linker.]) fi fi + + AC_SUBST([MergeObjsCmd]) + AC_SUBST([MergeObjsArgs]) ]) # FIND_PYTHON ===================================== configure.ac ===================================== @@ -448,6 +448,8 @@ then NM="${mingwbin}nm.exe" RANLIB="${mingwbin}ranlib.exe" OBJDUMP="${mingwbin}objdump.exe" + MergeObjsCmd="$LD" + MergeObjsArgs="-r --oformat=pe-bigobj-x86-64" fp_prog_ar="${mingwbin}ar.exe" AC_PATH_PROG([Genlib],[genlib]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -14,6 +14,7 @@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ nm = @NmCmd@ +merge-objects = @MergeObjsCmd@ objdump = @ObjdumpCmd@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ @@ -115,10 +116,10 @@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ -conf-merge-objects-args-stage0 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage1 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage2 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage3 = @SettingsMergeObjectsFlags@ +conf-merge-objects-args-stage0 = @MergeObjsArgs@ +conf-merge-objects-args-stage1 = @MergeObjsArgs@ +conf-merge-objects-args-stage2 = @MergeObjsArgs@ +conf-merge-objects-args-stage3 = @MergeObjsArgs@ # Settings: ===================================== hadrian/src/Builder.hs ===================================== @@ -312,7 +312,7 @@ systemBuilderPath builder = case builder of Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" Ld _ -> fromKey "ld" - MergeObjects _ -> fromKey "settings-merge-objects-command" + MergeObjects _ -> fromKey "merge-objects" Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" Nm -> fromKey "nm" ===================================== mk/config.mk.in ===================================== @@ -544,6 +544,16 @@ LD_STAGE1 = $(LD) LD_STAGE2 = $(LD) LD_STAGE3 = $(LD) +MERGE_OBJS_STAGE0 = @MergeObjsCmd@ +MERGE_OBJS_STAGE1 = @MergeObjsCmd@ +MERGE_OBJS_STAGE2 = @MergeObjsCmd@ +MERGE_OBJS_STAGE3 = @MergeObjsCmd@ + +MERGE_OBJS_STAGE0_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE1_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE2_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE3_FLAGS = @MergeObjsArgs@ + # Cross-compiling options # See Note [CrossCompiling vs Stage1Only] CrossCompiling = @CrossCompiling@ ===================================== rules/build-package-way.mk ===================================== @@ -107,6 +107,7 @@ endif endif # Build the GHCi library +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. ifneq "$(filter $3, v p)" "" $1_$2_$3_GHCI_LIB = $1/$2/build/HS$$($1_$2_COMPONENT_ID).$$($3_osuf) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" @@ -116,7 +117,7 @@ BINDIST_LIBS += $$($1_$2_$3_GHCI_LIB) endif endif $$($1_$2_$3_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) $$($1_$2_LD_SCRIPT) - $$(call cmd,SettingsMergeObjectsCommand) $(SettingsMergeObjectsFlags) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) + $$(call cmd,MERGE_OBJS_STAGE$4) $(MERGE_OBJS_STAGE$4_FLAGS) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" # Don't bother making ghci libs for bootstrapping packages ifneq "$4" "0" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ceb73fbc58913c465599f66af278e05eef6668ef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ceb73fbc58913c465599f66af278e05eef6668ef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 00:30:37 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 02 Sep 2020 20:30:37 -0400 Subject: [Git][ghc/ghc][wip/T18550] WIP Message-ID: <5f50392d3166f_80b3f848e6084a01034372d@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18550 at Glasgow Haskell Compiler / GHC Commits: 0d79c84b by Ben Gamari at 2020-09-02T20:30:29-04:00 WIP - - - - - 7 changed files: - aclocal.m4 - compiler/GHC/Settings/IO.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - mk/config.mk.in - rules/build-package-way.mk Changes: ===================================== aclocal.m4 ===================================== @@ -2635,6 +2635,7 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ # ------------------ # Find which linker to use to merge object files. # +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_REQUIRE([FIND_LD]) @@ -2655,6 +2656,9 @@ AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the MergeObjsCmd variable to a functional linker.]) fi fi + + AC_SUBST([MergeObjsCmd]) + AC_SUBST([MergeObjsArgs]) ]) # FIND_PYTHON ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -137,7 +137,7 @@ initSettings top_dir = do as_args = map Option cc_args ld_prog = cc_prog ld_args = map Option (cc_args ++ words cc_link_args_str) - ld_r_prog <- getSetting "Merge objects command" + ld_r_prog <- getToolSetting "Merge objects command" ld_r_args <- getSetting "Merge objects flags" llvmTarget <- getSetting "LLVM target" ===================================== configure.ac ===================================== @@ -448,6 +448,8 @@ then NM="${mingwbin}nm.exe" RANLIB="${mingwbin}ranlib.exe" OBJDUMP="${mingwbin}objdump.exe" + MergeObjsCmd="$LD" + MergeObjsArgs="-r --oformat=pe-bigobj-x86-64" fp_prog_ar="${mingwbin}ar.exe" AC_PATH_PROG([Genlib],[genlib]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -14,6 +14,7 @@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ nm = @NmCmd@ +merge-objects = @MergeObjsCmd@ objdump = @ObjdumpCmd@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ @@ -115,10 +116,10 @@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ -conf-merge-objects-args-stage0 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage1 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage2 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage3 = @SettingsMergeObjectsFlags@ +conf-merge-objects-args-stage0 = @MergeObjsArgs@ +conf-merge-objects-args-stage1 = @MergeObjsArgs@ +conf-merge-objects-args-stage2 = @MergeObjsArgs@ +conf-merge-objects-args-stage3 = @MergeObjsArgs@ # Settings: ===================================== hadrian/src/Builder.hs ===================================== @@ -312,7 +312,7 @@ systemBuilderPath builder = case builder of Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" Ld _ -> fromKey "ld" - MergeObjects _ -> fromKey "settings-merge-objects-command" + MergeObjects _ -> fromKey "merge-objects" Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" Nm -> fromKey "nm" ===================================== mk/config.mk.in ===================================== @@ -544,6 +544,16 @@ LD_STAGE1 = $(LD) LD_STAGE2 = $(LD) LD_STAGE3 = $(LD) +MERGE_OBJS_STAGE0 = @MergeObjsCmd@ +MERGE_OBJS_STAGE1 = @MergeObjsCmd@ +MERGE_OBJS_STAGE2 = @MergeObjsCmd@ +MERGE_OBJS_STAGE3 = @MergeObjsCmd@ + +MERGE_OBJS_STAGE0_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE1_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE2_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE3_FLAGS = @MergeObjsArgs@ + # Cross-compiling options # See Note [CrossCompiling vs Stage1Only] CrossCompiling = @CrossCompiling@ ===================================== rules/build-package-way.mk ===================================== @@ -107,6 +107,7 @@ endif endif # Build the GHCi library +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. ifneq "$(filter $3, v p)" "" $1_$2_$3_GHCI_LIB = $1/$2/build/HS$$($1_$2_COMPONENT_ID).$$($3_osuf) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" @@ -116,7 +117,7 @@ BINDIST_LIBS += $$($1_$2_$3_GHCI_LIB) endif endif $$($1_$2_$3_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) $$($1_$2_LD_SCRIPT) - $$(call cmd,SettingsMergeObjectsCommand) $(SettingsMergeObjectsFlags) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) + $$(call cmd,MERGE_OBJS_STAGE$4) $(MERGE_OBJS_STAGE$4_FLAGS) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" # Don't bother making ghci libs for bootstrapping packages ifneq "$4" "0" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d79c84ba8ce032336d8f01a69a68684e90fb451 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0d79c84ba8ce032336d8f01a69a68684e90fb451 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 02:21:23 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Wed, 02 Sep 2020 22:21:23 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] [macOS] improved runpath handling Message-ID: <5f505323d18c4_80b3f8495b831a81034592a@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: d122ac9a by Moritz Angermann at 2020-09-03T10:20:52+08:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - 16 changed files: - aclocal.m4 - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - docs/users_guide/phases.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - mk/config.mk.in - testsuite/tests/rts/all.T Changes: ===================================== aclocal.m4 ===================================== @@ -579,6 +579,18 @@ AC_DEFUN([FP_SETTINGS], else SettingsOptCommand="$OptCmd" fi + if test -z "$OtoolCmd" + then + SettingsOtoolCommand="otool" + else + SettingsOtoolCommand="$OtoolCmd" + fi + if test -z "$InstallNameToolCmd" + then + SettingsInstallNameToolCommand="install_name_tool" + else + SettingsInstallNameToolCommand="$InstallNameToolCmd" + fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -596,6 +608,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -394,7 +394,56 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commands. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc's ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1787,9 +1836,12 @@ linkBinary' staticLink dflags o_files dep_units = do rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then GHC.SysTools.runLibtool - else GHC.SysTools.runLink + let link dflags args | staticLink = GHC.SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = GHC.SysTools.runLink dflags args >> GHC.SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = GHC.SysTools.runLink dflags args + link dflags ( map GHC.SysTools.Option verbFlags ++ [ GHC.SysTools.Option "-o" @@ -1856,7 +1908,13 @@ linkBinary' staticLink dflags o_files dep_units = do ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -145,8 +145,8 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, + pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool, + pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -885,6 +885,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags +pgm_otool :: DynFlags -> String +pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) @@ -2267,6 +2271,10 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } + , make_ord_flag defFlag "pgmotool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f} + , make_ord_flag defFlag "pgminstall_name_tool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f} , make_ord_flag defFlag "pgmranlib" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } @@ -3780,7 +3788,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -3791,6 +3798,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -3831,6 +3840,29 @@ default_PIC platform = -- information. _ -> [] + +-- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS +-- versions the number of load commands we can embed in a dynamic library is +-- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only +-- link the needed dylibs instead of linking the full dependency closure. +-- +-- If we split the library linking into injecting -rpath and -l @rpath/... +-- components, we will reduce the number of libraries we link, however we will +-- still inject one -rpath entry for each library, independent of their use. +-- That is, we even inject -rpath values for libraries that we dead_strip in +-- the end. As such we can run afoul of the load command size limit simply +-- by polluting the load commands with RPATH entries. +-- +-- Thus, we disable Opt_RPath by default on OSDarwin. The savvy user can always +-- enable it with -use-rpath if they so wish. +-- +-- See Note [Dynamic linking on macOS] + +default_RPath :: Platform -> [GeneralFlag] +default_RPath platform | platformOS platform == OSDarwin = [] +default_RPath _ = [Opt_RPath] + + -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -929,20 +929,22 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,6 +34,8 @@ module GHC.Settings , sPgm_windres , sPgm_libtool , sPgm_ar + , sPgm_otool + , sPgm_install_name_tool , sPgm_ranlib , sPgm_lo , sPgm_lc @@ -107,6 +109,8 @@ data ToolSettings = ToolSettings , toolSettings_pgm_windres :: String , toolSettings_pgm_libtool :: String , toolSettings_pgm_ar :: String + , toolSettings_pgm_otool :: String + , toolSettings_pgm_install_name_tool :: String , toolSettings_pgm_ranlib :: String , -- | LLVM: opt llvm optimiser toolSettings_pgm_lo :: (String, [Option]) @@ -216,6 +220,10 @@ sPgm_libtool :: Settings -> String sPgm_libtool = toolSettings_pgm_libtool . sToolSettings sPgm_ar :: Settings -> String sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_otool :: Settings -> String +sPgm_otool = toolSettings_pgm_otool . sToolSettings +sPgm_install_name_tool :: Settings -> String +sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings sPgm_ranlib :: Settings -> String sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings sPgm_lo :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -115,6 +115,8 @@ initSettings top_dir = do windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -191,6 +193,8 @@ initSettings top_dir = do , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) ===================================== compiler/GHC/SysTools.hs ===================================== @@ -259,7 +259,10 @@ linkDynLib dflags0 o_files dep_packages | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `Set.member` ways dflags + -- Only if we want dynamic libraries + WayDyn `Set.member` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -384,8 +387,15 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the leftover + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -28,6 +28,10 @@ import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pa import GHC.SysTools.Process import GHC.SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,41 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included in the load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of libraries end up being truely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath at . +-- +-- See Note: [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + -- find any pre-existing LC_PATH items + info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib] + let paths = concatMap f info + where f ("path":p:_) = [p] + f _ = [] + lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ] + -- only find those rpaths, that aren't already in the library. + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths') + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -329,6 +368,17 @@ runAr dflags cwd args = traceToolCommand dflags "ar" $ do let ar = pgm_ar dflags runSomethingFiltered dflags id "Ar" ar args cwd Nothing +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing + runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do let ranlib = pgm_ranlib dflags ===================================== configure.ac ===================================== @@ -697,6 +697,18 @@ else fi AC_SUBST([LibtoolCmd]) +dnl ** Which otool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([OTOOL], [otool]) +OtoolCmd="$OTOOL" +AC_SUBST(OtoolCmd) + +dnl ** Which install_name_tool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool]) +InstallNameToolCmd="$INSTALL_NAME_TOOL" +AC_SUBST(InstallNameToolCmd) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -1520,6 +1532,8 @@ echo "\ libtool : $LibtoolCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd + otool : $OtoolCmd + install_name_tool : $InstallNameToolCmd windres : $WindresCmd dllwrap : $DllWrapCmd genlib : $GenlibCmd ===================================== docs/users_guide/phases.rst ===================================== @@ -95,6 +95,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only). +.. ghc-flag:: -pgmotool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inspect mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and + executables to read the dynamic library dependencies. We will compute + the necessary ``runpath``s to embed for the dependencies based on the + result of the ``otool`` call. + +.. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inject ``runpath`` into mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inject ``runpath``s into mach-o dynamic + libraries and executables. As detected by the ``otool`` call. + .. ghc-flag:: -pgmwindres ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the program for embedding manifests on Windows. :type: dynamic ===================================== hadrian/cfg/system.config.in ===================================== @@ -151,6 +151,8 @@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ +settings-otool-command = @SettingsOtoolCommand@ +settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-libtool-command = @SettingsLibtoolCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -114,6 +114,8 @@ data SettingsFileSetting | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_OtoolCommand + | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_LibtoolCommand @@ -200,6 +202,8 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_OtoolCommand -> "settings-otool-command" + SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -308,6 +308,8 @@ generateSettings = do , ("ar flags", expr $ lookupValueOrError configFile "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) ===================================== includes/ghc.mk ===================================== @@ -233,6 +233,8 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ + @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -504,6 +504,8 @@ SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ ===================================== testsuite/tests/rts/all.T ===================================== @@ -406,7 +406,7 @@ test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp - test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug']) test('T13676', - [when(opsys('darwin') or opsys('mingw32'), expect_broken(17447)), + [when(opsys('mingw32'), expect_broken(17447)), extra_files(['T13676.hs'])], ghci_script, ['T13676.script']) test('InitEventLogging', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d122ac9a76aee39eb06626085c1bb044b05bb3cc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d122ac9a76aee39eb06626085c1bb044b05bb3cc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 12:39:10 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 03 Sep 2020 08:39:10 -0400 Subject: [Git][ghc/ghc][wip/T14422] PmCheck: Disattach COMPLETE pragma lookup from TyCons Message-ID: <5f50e3ee4fddd_80b3f84a02c6cd0103916ed@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14422 at Glasgow Haskell Compiler / GHC Commits: 56336b73 by Sebastian Graf at 2020-09-03T14:38:32+02:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 22 changed files: - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/IfaceToCore.hs-boot - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Env.hs - docs/users_guide/exts/pragmas.rst - testsuite/tests/pmcheck/complete_sigs/completesig15.hs → testsuite/tests/pmcheck/complete_sigs/T14422.hs - + testsuite/tests/pmcheck/complete_sigs/T18277.hs - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/complete_sigs/completesig04.hs - testsuite/tests/pmcheck/complete_sigs/completesig04.stderr - − testsuite/tests/pmcheck/complete_sigs/completesig15.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Driver.Types ( lookupIfaceByModule, emptyPartialModIface, emptyFullModIface, lookupHptByModule, PackageInstEnv, PackageFamInstEnv, PackageRuleBase, - PackageCompleteMatchMap, + PackageCompleteMatches, mkSOName, mkHsSOName, soExt, @@ -146,8 +146,7 @@ module GHC.Driver.Types ( handleFlagWarnings, printOrThrowWarnings, -- * COMPLETE signature - CompleteMatch(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap, + ConLikeSet, CompleteMatch, CompleteMatches, -- * Exstensible Iface fields ExtensibleFields(..), FieldName, @@ -734,7 +733,7 @@ lookupIfaceByModule hpt pit mod -- of its own, but it doesn't seem worth the bother. hptCompleteSigs :: HscEnv -> [CompleteMatch] -hptCompleteSigs = hptAllThings (md_complete_sigs . hm_details) +hptCompleteSigs = hptAllThings (md_complete_matches . hm_details) -- | Find all the instance declarations (of classes and families) from -- the Home Package Table filtered by the provided predicate function. @@ -1092,7 +1091,7 @@ data ModIface_ (phase :: ModIfacePhase) -- itself) but imports some trustworthy modules from its own -- package (which does require its own package be trusted). -- See Note [Trust Own Package] in GHC.Rename.Names - mi_complete_sigs :: [IfaceCompleteMatch], + mi_complete_matches :: [IfaceCompleteMatch], mi_doc_hdr :: Maybe HsDocString, -- ^ Module header. @@ -1183,7 +1182,7 @@ instance Binary ModIface where mi_hpc = hpc_info, mi_trust = trust, mi_trust_pkg = trust_pkg, - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1229,7 +1228,7 @@ instance Binary ModIface where put_ bh hpc_info put_ bh trust put_ bh trust_pkg - put_ bh complete_sigs + put_ bh complete_matches lazyPut bh doc_hdr lazyPut bh decl_docs lazyPut bh arg_docs @@ -1262,7 +1261,7 @@ instance Binary ModIface where hpc_info <- get bh trust <- get bh trust_pkg <- get bh - complete_sigs <- get bh + complete_matches <- get bh doc_hdr <- lazyGet bh decl_docs <- lazyGet bh arg_docs <- lazyGet bh @@ -1286,7 +1285,7 @@ instance Binary ModIface where mi_trust = trust, mi_trust_pkg = trust_pkg, -- And build the cached values - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1331,7 +1330,7 @@ emptyPartialModIface mod mi_hpc = False, mi_trust = noIfaceTrustInfo, mi_trust_pkg = False, - mi_complete_sigs = [], + mi_complete_matches = [], mi_doc_hdr = Nothing, mi_decl_docs = emptyDeclDocMap, mi_arg_docs = emptyArgDocMap, @@ -1387,7 +1386,7 @@ data ModDetails md_rules :: ![CoreRule], -- ^ Domain may include 'Id's from other modules md_anns :: ![Annotation], -- ^ Annotations present in this module: currently -- they only annotate things also declared in this module - md_complete_sigs :: [CompleteMatch] + md_complete_matches :: [CompleteMatch] -- ^ Complete match pragmas for this module } @@ -1400,7 +1399,7 @@ emptyModDetails md_rules = [], md_fam_insts = [], md_anns = [], - md_complete_sigs = [] } + md_complete_matches = [] } -- | Records the modules directly imported by a module for extracting e.g. -- usage information, and also to give better error message @@ -1463,7 +1462,7 @@ data ModGuts -- ^ Files to be compiled with the C compiler mg_warns :: !Warnings, -- ^ Warnings declared in the module mg_anns :: [Annotation], -- ^ Annotations declared in this module - mg_complete_sigs :: [CompleteMatch], -- ^ Complete Matches + mg_complete_matches :: [CompleteMatch], -- ^ Complete Matches mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module @@ -2684,7 +2683,7 @@ type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv type PackageAnnEnv = AnnEnv -type PackageCompleteMatchMap = CompleteMatchMap +type PackageCompleteMatches = CompleteMatches -- | Information about other packages that we have slurped in by reading -- their interface files @@ -2746,8 +2745,8 @@ data ExternalPackageState -- from all the external-package modules eps_ann_env :: !PackageAnnEnv, -- ^ The total 'AnnEnv' accumulated -- from all the external-package modules - eps_complete_matches :: !PackageCompleteMatchMap, - -- ^ The total 'CompleteMatchMap' accumulated + eps_complete_matches :: !PackageCompleteMatches, + -- ^ The total 'CompleteMatches' accumulated -- from all the external-package modules eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external @@ -3203,36 +3202,13 @@ byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) ------------------------------------------- +type ConLikeSet = UniqDSet ConLike + -- | A list of conlikes which represents a complete pattern match. -- These arise from @COMPLETE@ signatures. +type CompleteMatch = ConLikeSet --- See Note [Implementation of COMPLETE signatures] -data CompleteMatch = CompleteMatch { - completeMatchConLikes :: [Name] - -- ^ The ConLikes that form a covering family - -- (e.g. Nothing, Just) - , completeMatchTyCon :: Name - -- ^ The TyCon that they cover (e.g. Maybe) - } - -instance Outputable CompleteMatch where - ppr (CompleteMatch cl ty) = text "CompleteMatch:" <+> ppr cl - <+> dcolon <+> ppr ty - --- | A map keyed by the 'completeMatchTyCon' which has type Name. - --- See Note [Implementation of COMPLETE signatures] -type CompleteMatchMap = UniqFM Name [CompleteMatch] - -mkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap -mkCompleteMatchMap = extendCompleteMatchMap emptyUFM - -extendCompleteMatchMap :: CompleteMatchMap -> [CompleteMatch] - -> CompleteMatchMap -extendCompleteMatchMap = foldl' insertMatch - where - insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap - insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c] +type CompleteMatches = [CompleteMatch] {- Note [Implementation of COMPLETE signatures] @@ -3252,33 +3228,14 @@ function, it gives rise to a total function. An example is: booleanToInt F = 0 booleanToInt T = 1 -COMPLETE sets are represented internally in GHC with the CompleteMatch data -type. For example, {-# COMPLETE F, T #-} would be represented as: - - CompleteMatch { complateMatchConLikes = [F, T] - , completeMatchTyCon = Boolean } - -Note that GHC was able to infer the completeMatchTyCon (Boolean), but for the -cases in which it's ambiguous, you can also explicitly specify it in the source -language by writing this: - - {-# COMPLETE F, T :: Boolean #-} - -For efficiency purposes, GHC collects all of the CompleteMatches that it knows -about into a CompleteMatchMap, which is a map that is keyed by the -completeMatchTyCon. In other words, you could have a multiple COMPLETE sets -for the same TyCon: - - {-# COMPLETE F, T1 :: Boolean #-} - {-# COMPLETE F, T2 :: Boolean #-} +COMPLETE sets are represented internally in GHC a set of 'ConLike's. For +example, {-# COMPLETE F, T #-} would be represented as: -And looking up the values in the CompleteMatchMap associated with Boolean -would give you [CompleteMatch [F, T1] Boolean, CompleteMatch [F, T2] Boolean]. -dsGetCompleteMatches in GHC.HsToCore.Quote accomplishes this lookup. + {F, T} -Also see Note [Typechecking Complete Matches] in GHC.Tc.Gen.Bind for a more detailed -explanation for how GHC ensures that all the conlikes in a COMPLETE set are -consistent. +GHC collects all COMPLETE pragmas from the current module and from imports +into a field in the DsM environment, which can be accessed with +dsGetCompleteMatches from "GHC.HsToCore.Monad". -} -- | Foreign language of the phase if the phase deals with a foreign code ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -224,7 +224,7 @@ deSugar hsc_env mg_modBreaks = modBreaks, mg_safe_haskell = safe_mode, mg_trust_pkg = imp_trust_own_pkg imports, - mg_complete_sigs = complete_matches, + mg_complete_matches = complete_matches, mg_doc_hdr = doc_hdr, mg_decl_docs = decl_docs, mg_arg_docs = arg_docs ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -88,7 +88,6 @@ import GHC.Driver.Ppr import GHC.Utils.Error import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Types.Unique.FM ( lookupWithDefaultUFM_Directly ) import GHC.Types.Literal ( mkLitString ) import GHC.Types.CostCentre.State @@ -210,13 +209,15 @@ mkDsEnvsFromTcGbl :: MonadIO m -> m (DsGblEnv, DsLclEnv) mkDsEnvsFromTcGbl hsc_env msg_var tcg_env = do { cc_st_var <- liftIO $ newIORef newCostCentreState + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env this_mod = tcg_mod tcg_env type_env = tcg_type_env tcg_env rdr_env = tcg_rdr_env tcg_env fam_inst_env = tcg_fam_inst_env tcg_env - complete_matches = hptCompleteSigs hsc_env - ++ tcg_complete_matches tcg_env + complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ tcg_complete_matches tcg_env -- from the current module + ++ eps_complete_matches eps -- from imports ; return $ mkDsEnvs dflags this_mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches } @@ -239,13 +240,15 @@ initDsWithModGuts :: HscEnv -> ModGuts -> DsM a -> IO (Messages, Maybe a) initDsWithModGuts hsc_env guts thing_inside = do { cc_st_var <- newIORef newCostCentreState ; msg_var <- newIORef emptyMessages + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts) rdr_env = mg_rdr_env guts fam_inst_env = mg_fam_inst_env guts this_mod = mg_module guts - complete_matches = hptCompleteSigs hsc_env - ++ mg_complete_sigs guts + complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ mg_complete_matches guts -- from the current module + ++ eps_complete_matches eps -- from imports bindsToIds (NonRec v _) = [v] bindsToIds (Rec binds) = map fst binds @@ -281,7 +284,7 @@ initTcDsForSolver thing_inside thing_inside } mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv - -> IORef Messages -> IORef CostCentreState -> [CompleteMatch] + -> IORef Messages -> IORef CostCentreState -> CompleteMatches -> (DsGblEnv, DsLclEnv) mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches @@ -290,7 +293,6 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod) NotBoot real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1) - completeMatchMap = mkCompleteMatchMap complete_matches gbl_env = DsGblEnv { ds_mod = mod , ds_fam_inst_env = fam_inst_env , ds_if_env = (if_genv, if_lenv) @@ -299,7 +301,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var (mkHomeUnitFromFlags dflags) rdr_env , ds_msgs = msg_var - , ds_complete_matches = completeMatchMap + , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv @@ -533,18 +535,9 @@ dsGetFamInstEnvs dsGetMetaEnv :: DsM (NameEnv DsMetaVal) dsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) } --- | The @COMPLETE@ pragmas provided by the user for a given `TyCon`. -dsGetCompleteMatches :: TyCon -> DsM [CompleteMatch] -dsGetCompleteMatches tc = do - eps <- getEps - env <- getGblEnv - -- We index into a UniqFM from Name -> elt, for tyCon it holds that - -- getUnique (tyConName tc) == getUnique tc. So we lookup using the - -- unique directly instead. - let lookup_completes ufm = lookupWithDefaultUFM_Directly ufm [] (getUnique tc) - eps_matches_list = lookup_completes $ eps_complete_matches eps - env_matches_list = lookup_completes $ ds_complete_matches env - return $ eps_matches_list ++ env_matches_list +-- | The @COMPLETE@ pragmas that are in scope. +dsGetCompleteMatches :: DsM CompleteMatches +dsGetCompleteMatches = ds_complete_matches <$> getGblEnv dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal) dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (dsl_meta env) name) } ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -66,13 +66,13 @@ import GHC.Core.TyCo.Rep import GHC.Core.Type import GHC.Tc.Solver (tcNormalise, tcCheckSatisfiability) import GHC.Core.Unify (tcMatchTy) -import GHC.Tc.Types (completeMatchConLikes) import GHC.Core.Coercion import GHC.Utils.Monad hiding (foldlM) import GHC.HsToCore.Monad hiding (foldlM) import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv +import Control.Applicative ((<|>)) import Control.Monad (guard, mzero, when) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict @@ -80,7 +80,6 @@ import Data.Bifunctor (second) import Data.Either (partitionEithers) import Data.Foldable (foldlM, minimumBy, toList) import Data.List (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ord (comparing) import qualified Data.Semigroup as Semigroup import Data.Tuple (swap) @@ -105,11 +104,54 @@ mkPmId ty = getUniqueM >>= \unique -> ----------------------------------------------- -- * Caching possible matches of a COMPLETE set -markMatched :: ConLike -> PossibleMatches -> PossibleMatches -markMatched _ NoPM = NoPM -markMatched con (PM ms) = PM (del_one_con con <$> ms) +-- | Traverse the COMPLETE sets of 'ResidualCompleteMatches'. +trvRcm :: Applicative f => (ConLikeSet -> f ConLikeSet) -> ResidualCompleteMatches -> f ResidualCompleteMatches +trvRcm f (RCM vanilla pragmas) = RCM <$> traverse f vanilla + <*> traverse (traverse f) pragmas +-- | Update the COMPLETE sets of 'ResidualCompleteMatches'. +updRcm :: (ConLikeSet -> ConLikeSet) -> ResidualCompleteMatches -> ResidualCompleteMatches +updRcm f (RCM vanilla pragmas) = RCM (f <$> vanilla) (fmap f <$> pragmas) + +-- | A pseudo-'CompleteMatch' for the vanilla complete set of the given data +-- 'TyCon'. +-- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ +vanillaCompleteMatchTC :: TyCon -> Maybe ConLikeSet +vanillaCompleteMatchTC tc = + let -- | TYPE acts like an empty data type on the term-level (#14086), but + -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a + -- special case. + mb_dcs | tc == tYPETyCon = Just [] + | otherwise = tyConDataCons_maybe tc + in mkUniqDSet . map RealDataCon <$> mb_dcs + +-- | Initialise from 'dsGetCompleteMatches' (containing all COMPLETE pragmas) +-- if the given 'ResidualCompleteMatches' were empty. +addCompleteMatches :: ResidualCompleteMatches -> DsM ResidualCompleteMatches +addCompleteMatches (RCM v Nothing) = RCM v . Just <$> dsGetCompleteMatches +addCompleteMatches rcm = pure rcm + +-- | Adds the declared 'CompleteMatches' from COMPLETE pragmas, as well as the +-- vanilla data defn if it is a 'DataCon'. +addConLikeMatches :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addConLikeMatches (RealDataCon dc) rcm = addTyConMatches (dataConTyCon dc) rcm +addConLikeMatches (PatSynCon _) rcm = addCompleteMatches rcm + +-- | Adds +-- * the 'CompleteMatches' from COMPLETE pragmas +-- * and the /vanilla/ 'CompleteMatch' from the data 'TyCon' +-- to the 'ResidualCompleteMatches', if not already present. +addTyConMatches :: TyCon -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addTyConMatches tc rcm = add_tc_match <$> addCompleteMatches rcm where - del_one_con = flip delOneFromUniqDSet + -- | Add the vanilla COMPLETE set from the data defn, if any. But only if + -- it's not already present. + add_tc_match rcm + = rcm{rcm_vanilla = rcm_vanilla rcm <|> vanillaCompleteMatchTC tc} + +markMatched :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +markMatched cl rcm = do + rcm' <- addConLikeMatches cl rcm + pure $ updRcm (flip delOneFromUniqDSet cl) rcm' --------------------------------------------------- -- * Instantiating constructors, types and evidence @@ -492,7 +534,7 @@ tyOracle (TySt inert) cts -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. Doesn't bother calling out to the type oracle if the bag of new type --- constraints was empty. Will only recheck 'PossibleMatches' in the term oracle +-- constraints was empty. Will only recheck 'ResidualCompleteMatches' in the term oracle -- for emptiness if the first argument is 'True'. tyIsSatisfiable :: Bool -> Bag PredType -> SatisfiabilityCheck tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \nabla -> @@ -544,10 +586,10 @@ of a PatSynCon (Just42,[]), this solution is incomparable to both Nothing and Just. Hence we retain the info in vi_neg, which eventually allows us to detect the complete pattern match. -The Pos/Neg invariant extends to vi_cache, which stores essentially positive -information. We make sure that vi_neg and vi_cache never overlap. This isn't -strictly necessary since vi_cache is just a cache, so doesn't need to be -accurate: Every suggestion of a possible ConLike from vi_cache might be +The Pos/Neg invariant extends to vi_rcm, which stores essentially positive +information. We make sure that vi_neg and vi_rcm never overlap. This isn't +strictly necessary since vi_rcm is just a cache, so doesn't need to be +accurate: Every suggestion of a possible ConLike from vi_rcm might be refutable by the type oracle anyway. But it helps to maintain sanity while debugging traces. @@ -568,7 +610,7 @@ The term oracle state is never obviously (i.e., without consulting the type oracle) contradictory. This implies a few invariants: * Whenever vi_pos overlaps with vi_neg according to 'eqPmAltCon', we refute. This is implied by the Note [Pos/Neg invariant]. -* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_cache to +* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_rcm to detect this, but we could just compare whole COMPLETE sets to vi_neg every time, if it weren't for performance. @@ -624,13 +666,16 @@ tmIsSatisfiable new_tm_cs = SC $ \nabla -> runMaybeT $ foldlM addTmCt nabla new_ ----------------------- -- * Looking up VarInfo +emptyRCM :: ResidualCompleteMatches +emptyRCM = RCM Nothing Nothing + emptyVarInfo :: Id -> VarInfo -- We could initialise @bot@ to @Just False@ in case of an unlifted type here, -- but it's cleaner to let the user of the constraint solver take care of this. -- After all, there are also strict fields, the unliftedness of which isn't -- evident in the type. So treating unlifted types here would never be -- sufficient anyway. -emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot NoPM +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot emptyRCM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' @@ -656,85 +701,6 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of | isNewDataCon dc = Just y go _ = Nothing -initPossibleMatches :: TyState -> VarInfo -> DsM VarInfo -initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do - -- New evidence might lead to refined info on ty, in turn leading to discovery - -- of a COMPLETE set. - res <- pmTopNormaliseType ty_st ty - let ty' = normalisedSourceType res - case splitTyConApp_maybe ty' of - Nothing -> pure vi{ vi_ty = ty' } - Just (tc, [_]) - | tc == tYPETyCon - -- TYPE acts like an empty data type on the term-level (#14086), but - -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a - -- special case. - -> pure vi{ vi_ty = ty', vi_cache = PM (pure emptyUniqDSet) } - Just (tc, tc_args) -> do - -- See Note [COMPLETE sets on data families] - (tc_rep, tc_fam) <- case tyConFamInst_maybe tc of - Just (tc_fam, _) -> pure (tc, tc_fam) - Nothing -> do - env <- dsGetFamInstEnvs - let (tc_rep, _tc_rep_args, _co) = tcLookupDataFamInst env tc tc_args - pure (tc_rep, tc) - -- Note that the common case here is tc_rep == tc_fam - let mb_rdcs = map RealDataCon <$> tyConDataCons_maybe tc_rep - let rdcs = maybeToList mb_rdcs - -- NB: tc_fam, because COMPLETE sets are associated with the parent data - -- family TyCon - pragmas <- dsGetCompleteMatches tc_fam - let fams = mapM dsLookupConLike . completeMatchConLikes - pscs <- mapM fams pragmas - -- pprTrace "initPossibleMatches" (ppr ty $$ ppr ty' $$ ppr tc_rep <+> ppr tc_fam <+> ppr tc_args $$ ppr (rdcs ++ pscs)) (return ()) - case NonEmpty.nonEmpty (rdcs ++ pscs) of - Nothing -> pure vi{ vi_ty = ty' } -- Didn't find any COMPLETE sets - Just cs -> pure vi{ vi_ty = ty', vi_cache = PM (mkUniqDSet <$> cs) } -initPossibleMatches _ vi = pure vi - -{- Note [COMPLETE sets on data families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -User-defined COMPLETE sets involving data families are attached to the family -TyCon, whereas the built-in COMPLETE set is attached to a data family instance's -representation TyCon. This matters for COMPLETE sets involving both DataCons -and PatSyns (from #17207): - - data family T a - data family instance T () = A | B - pattern C = B - {-# COMPLETE A, C #-} - f :: T () -> () - f A = () - f C = () - -The match on A is actually wrapped in a CoPat, matching impedance between T () -and its representation TyCon, which we translate as - at x | let y = x |> co, A <- y@ in PmCheck. - -Which TyCon should we use for looking up the COMPLETE set? The representation -TyCon from the match on A would only reveal the built-in COMPLETE set, while the -data family TyCon would only give the user-defined one. But when initialising -the PossibleMatches for a given Type, we want to do so only once, because -merging different COMPLETE sets after the fact is very complicated and possibly -inefficient. - -So in fact, we just *drop* the coercion arising from the CoPat when handling -handling the constraint @y ~ x |> co@ in addCoreCt, just equating @y ~ x at . -We then handle the fallout in initPossibleMatches, which has to get a hand at -both the representation TyCon tc_rep and the parent data family TyCon tc_fam. -It considers three cases after having established that the Type is a TyConApp: - -1. The TyCon is a vanilla data type constructor -2. The TyCon is tc_rep -3. The TyCon is tc_fam - -1. is simple and subsumed by the handling of the other two. -We check for case 2. by 'tyConFamInst_maybe' and get the tc_fam out. -Otherwise (3.), we try to lookup the data family instance at that particular -type to get out the tc_rep. In case 1., this will just return the original -TyCon, so tc_rep = tc_fam afterwards. --} - ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -897,11 +863,7 @@ addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do - -- For good performance, it's important to initPossibleMatches here. - -- Otherwise we can't mark nalt as matched later on, incurring unnecessary - -- inhabitation tests for nalt. - vi@(VI _ pos neg _ pm) <- lift $ initPossibleMatches (nabla_ty_st nabla) - (lookupVarInfo ts x) + let vi@(VI _ pos neg _ rcm) = lookupVarInfo ts x -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt (cl, _tvs, _args) = eqPmAltCon cl nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -917,9 +879,11 @@ addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor vi2 <- case nalt of - PmAltConLike cl - -> ensureInhabited nabla vi1{ vi_cache = markMatched cl pm } - _ -> pure vi1 + PmAltConLike cl -> do + rcm' <- lift (markMatched cl rcm) + ensureInhabited nabla vi1{ vi_rcm = rcm' } + _ -> + pure vi1 pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } hasRequiredTheta :: PmAltCon -> Bool @@ -963,13 +927,15 @@ storing required arguments along with the PmAltConLike in 'vi_neg'. -- its result type. Rather easy for DataCons, but not so much for PatSynCons. -- See Note [Pattern synonym result type] in "GHC.Core.PatSyn". guessConLikeUnivTyArgsFromResTy :: FamInstEnvs -> Type -> ConLike -> Maybe [Type] -guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon _) = do +guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon dc) = do (tc, tc_args) <- splitTyConApp_maybe res_ty -- Consider data families: In case of a DataCon, we need to translate to -- the representation TyCon. For PatSyns, they are relative to the data -- family TyCon, so we don't need to translate them. - let (_, tc_args', _) = tcLookupDataFamInst env tc tc_args - Just tc_args' + let (rep_tc, tc_args', _) = tcLookupDataFamInst env tc tc_args + if rep_tc == dataConTyCon dc + then Just tc_args' + else Nothing guessConLikeUnivTyArgsFromResTy _ res_ty (PatSynCon ps) = do -- We are successful if we managed to instantiate *every* univ_tv of con. -- This is difficult and bound to fail in some cases, see @@ -998,7 +964,7 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do -- | Returns (Just vi) if at least one member of each ConLike in the COMPLETE -- set satisfies the oracle -- --- Internally uses and updates the ConLikeSets in vi_cache. +-- Internally uses and updates the ConLikeSets in vi_rcm. -- -- NB: Does /not/ filter each ConLikeSet with the oracle; members may -- remain that do not statisfy it. This lazy approach just @@ -1007,17 +973,31 @@ ensureInhabited :: Nabla -> VarInfo -> MaybeT DsM VarInfo ensureInhabited nabla vi = case vi_bot vi of MaybeBot -> pure vi -- The |-Bot rule from the paper IsBot -> pure vi - IsNotBot -> lift (initPossibleMatches (nabla_ty_st nabla) vi) >>= inst_complete_sets + IsNotBot -> lift (add_matches vi) >>= inst_complete_sets where + add_matches :: VarInfo -> DsM VarInfo + add_matches vi = do + res <- pmTopNormaliseType (nabla_ty_st nabla) (vi_ty vi) + rcm <- case reprTyCon_maybe (normalisedSourceType res) of + Just tc -> addTyConMatches tc (vi_rcm vi) + Nothing -> addCompleteMatches (vi_rcm vi) + pure vi{ vi_rcm = rcm } + + reprTyCon_maybe :: Type -> Maybe TyCon + reprTyCon_maybe ty = case splitTyConApp_maybe ty of + Nothing -> Nothing + Just (tc, _args) -> case tyConFamInst_maybe tc of + Nothing -> Just tc + Just (tc_fam, _) -> Just tc_fam + -- | This is the |-Inst rule from the paper (section 4.5). Tries to -- find an inhabitant in every complete set by instantiating with one their -- constructors. If there is any complete set where we can't find an -- inhabitant, the whole thing is uninhabited. inst_complete_sets :: VarInfo -> MaybeT DsM VarInfo - inst_complete_sets vi at VI{ vi_cache = NoPM } = pure vi - inst_complete_sets vi at VI{ vi_cache = PM ms } = do - ms <- traverse (\cs -> inst_complete_set vi cs (uniqDSetToList cs)) ms - pure vi{ vi_cache = PM ms } + inst_complete_sets vi at VI{ vi_rcm = rcm } = do + rcm' <- trvRcm (\cls -> inst_complete_set vi cls (uniqDSetToList cls)) rcm + pure vi{ vi_rcm = rcm' } inst_complete_set :: VarInfo -> ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet -- (inst_complete_set cs cls) iterates over cls, deleting from cs @@ -1052,7 +1032,7 @@ ensureInhabited nabla vi = case vi_bot vi of ] -- | Checks if every 'VarInfo' in the term oracle has still an inhabited --- 'vi_cache', considering the current type information in 'Nabla'. +-- 'vi_rcm', considering the current type information in 'Nabla'. -- This check is necessary after having matched on a GADT con to weed out -- impossible matches. ensureAllInhabited :: Nabla -> DsM (Maybe Nabla) @@ -1111,7 +1091,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- Do the same for negative info let add_refut nabla nalt = addNotConCt nabla y nalt nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) - -- vi_cache will be updated in addNotConCt, so we are good to + -- vi_rcm will be updated in addNotConCt, so we are good to -- go! pure nabla_neg @@ -1123,7 +1103,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do - let VI ty pos neg bot cache = lookupVarInfo ts x + let VI ty pos neg bot rcm = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -1142,7 +1122,8 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do MaybeT $ addPmCts nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = (alt, tvs, args):pos - let nabla_with bot = nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot cache)) reps} + let nabla_with bot = + nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot rcm)) reps} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -1574,7 +1555,7 @@ provideEvidence = go try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. try_instantiate x xs n nabla = do - (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) let build_newtype (x, nabla) (_ty, dc, arg_ty) = do y <- lift $ mkPmId arg_ty -- Newtypes don't have existentials (yet?!), so passing an empty @@ -1586,10 +1567,12 @@ provideEvidence = go Just (y, newty_nabla) -> do -- Pick a COMPLETE set and instantiate it (n at max). Take care of ⊥. let vi = lookupVarInfo (nabla_tm_st newty_nabla) y - vi <- initPossibleMatches (nabla_ty_st newty_nabla) vi - mb_cls <- pickMinimalCompleteSet newty_nabla (vi_cache vi) + rcm <- case splitTyConApp_maybe rep_ty of + Nothing -> pure (vi_rcm vi) + Just (tc, _) -> addTyConMatches tc (vi_rcm vi) + mb_cls <- pickMinimalCompleteSet rep_ty rcm case uniqDSetToList <$> mb_cls of - Just cls@(_:_) -> instantiate_cons y core_ty xs n newty_nabla cls + Just cls@(_:_) -> instantiate_cons y rep_ty xs n newty_nabla cls Just [] | vi_bot vi == IsNotBot -> pure [] -- Either ⊥ is still possible (think Void) or there are no COMPLETE -- sets available, so we can assume it's inhabited @@ -1631,13 +1614,15 @@ provideEvidence = go other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls pure (con_nablas ++ other_cons_nablas) -pickMinimalCompleteSet :: Nabla -> PossibleMatches -> DsM (Maybe ConLikeSet) -pickMinimalCompleteSet _ NoPM = pure Nothing --- TODO: First prune sets with type info in nabla. But this is good enough for --- now and less costly. See #17386. -pickMinimalCompleteSet _ (PM clss) = do - tracePm "pickMinimalCompleteSet" (ppr $ NonEmpty.toList clss) - pure (Just (minimumBy (comparing sizeUniqDSet) clss)) +pickMinimalCompleteSet :: Type -> ResidualCompleteMatches -> DsM (Maybe ConLikeSet) +pickMinimalCompleteSet ty rcm = do + env <- dsGetFamInstEnvs + pure $ case filter (all (is_valid env) . uniqDSetToList) (getRcm rcm) of + [] -> Nothing + clss' -> Just (minimumBy (comparing sizeUniqDSet) clss') + where + is_valid :: FamInstEnvs -> ConLike -> Bool + is_valid env cl = isJust (guessConLikeUnivTyArgsFromResTy env ty cl) -- | Finds a representant of the semantic equality class of the given @e at . -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -24,8 +24,8 @@ module GHC.HsToCore.PmCheck.Types ( literalToPmLit, negatePmLit, overloadPmLit, pmLitAsStringLit, coreExprAsPmLit, - -- * Caching partially matched COMPLETE sets - ConLikeSet, PossibleMatches(..), + -- * Caching residual COMPLETE sets + ConLikeSet, ResidualCompleteMatches(..), getRcm, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -69,10 +69,10 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) import Data.Foldable (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ratio import qualified Data.Semigroup as Semi @@ -415,21 +415,31 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show -type ConLikeSet = UniqDSet ConLike +-- | A data type that caches for the 'VarInfo' of @x@ the results of querying +-- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for +-- which we already know @x /~ K@ from these sets. +-- +-- For motivation, see Section 5.3 in Lower Your Guards. +data ResidualCompleteMatches + = RCM + { rcm_vanilla :: !(Maybe ConLikeSet) + -- ^ The residual set for the vanilla COMPLETE set from the data defn. + -- Tracked separately from 'rcm_pragmas', because it might only be + -- known much later (when we have enough type information to see the 'TyCon' + -- of the match), or not at all even. Until that happens, it is 'Nothing'. + , rcm_pragmas :: !(Maybe [ConLikeSet]) + -- ^ The residual sets for /all/ COMPLETE sets from pragmas that are + -- visible when compiling this module. Querying that set with + -- 'dsGetCompleteMatches' requires 'DsM', so we initialise it with 'Nothing' + -- until first needed in a 'DsM' context. + } --- | A data type caching the results of 'completeMatchConLikes' with support for --- deletion of constructors that were already matched on. -data PossibleMatches - = PM (NonEmpty.NonEmpty ConLikeSet) - -- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE set - -- 'NonEmpty' because the empty case would mean that the type has no COMPLETE - -- set at all, for which we have 'NoPM'. - | NoPM - -- ^ No COMPLETE set for this type (yet). Think of overloaded literals. +getRcm :: ResidualCompleteMatches -> [ConLikeSet] +getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas -instance Outputable PossibleMatches where - ppr (PM cs) = ppr (NonEmpty.toList cs) - ppr NoPM = text "" +instance Outputable ResidualCompleteMatches where + -- formats as "[{Nothing,Just},{P,Q}]" + ppr rcm = ppr (getRcm rcm) -- | Either @Indirect x@, meaning the value is represented by that of @x@, or -- an @Entry@ containing containing the actual value it represents. @@ -516,8 +526,8 @@ data TmState -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". --- Also caches the type ('vi_ty'), the 'PossibleMatches' of a COMPLETE set --- ('vi_cache'). +-- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set +-- ('vi_rcm'). -- -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo @@ -559,7 +569,7 @@ data VarInfo -- * 'IsBot': @x ~ ⊥@ -- * 'IsNotBot': @x ≁ ⊥@ - , vi_cache :: !PossibleMatches + , vi_rcm :: !ResidualCompleteMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of -- possible constructors of each COMPLETE set. So, if it's not in here, we -- can't possibly match on it. Complementary to 'vi_neg'. We still need it ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -38,7 +38,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.IfaceToCore ( tcIfaceDecl, tcIfaceRules, tcIfaceInst, tcIfaceFamInst - , tcIfaceAnnotations, tcIfaceCompleteSigs ) + , tcIfaceAnnotations, tcIfaceCompleteMatches ) import GHC.Driver.Session import GHC.Driver.Backend @@ -479,7 +479,7 @@ loadInterface doc_str mod from ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) ; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface) ; new_eps_anns <- tcIfaceAnnotations (mi_anns iface) - ; new_eps_complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + ; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT", @@ -509,9 +509,7 @@ loadInterface doc_str mod from eps_rule_base = extendRuleBaseList (eps_rule_base eps) new_eps_rules, eps_complete_matches - = extendCompleteMatchMap - (eps_complete_matches eps) - new_eps_complete_sigs, + = eps_complete_matches eps ++ new_eps_complete_matches, eps_inst_env = extendInstEnvList (eps_inst_env eps) new_eps_insts, eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps) @@ -1037,9 +1035,8 @@ initExternalPackageState home_unit eps_fam_inst_env = emptyFamInstEnv, eps_rule_base = mkRuleBase builtinRules', -- Initialise the EPS rule pool with the built-in rules - eps_mod_fam_inst_env - = emptyModuleEnv, - eps_complete_matches = emptyUFM, + eps_mod_fam_inst_env = emptyModuleEnv, + eps_complete_matches = [], eps_ann_env = emptyAnnEnv, eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0 , n_insts_in = 0, n_insts_out = 0 @@ -1181,7 +1178,7 @@ pprModIface iface at ModIface{ mi_final_exts = exts } , ppr (mi_warns iface) , pprTrustInfo (mi_trust iface) , pprTrustPkg (mi_trust_pkg iface) - , vcat (map ppr (mi_complete_sigs iface)) + , vcat (map ppr (mi_complete_matches iface)) , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface)) , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface)) , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface)) ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -57,6 +57,7 @@ import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Name.Env import GHC.Types.Name.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Utils.Error import GHC.Utils.Outputable @@ -220,7 +221,7 @@ mkIface_ hsc_env md_anns = anns, md_types = type_env, md_exports = exports, - md_complete_sigs = complete_sigs } + md_complete_matches = complete_matches } -- NB: notice that mkIface does not look at the bindings -- only at the TypeEnv. The previous Tidy phase has -- put exactly the info into the TypeEnv that we want @@ -256,7 +257,7 @@ mkIface_ hsc_env iface_fam_insts = map famInstToIfaceFamInst fam_insts trust_info = setSafeMode safe_mode annotations = map mkIfaceAnnotation anns - icomplete_sigs = map mkIfaceCompleteSig complete_sigs + icomplete_matches = map mkIfaceCompleteMatch complete_matches ModIface { mi_module = this_mod, @@ -285,7 +286,7 @@ mkIface_ hsc_env mi_hpc = isHpcUsed hpc_info, mi_trust = trust_info, mi_trust_pkg = pkg_trust_req, - mi_complete_sigs = icomplete_sigs, + mi_complete_matches = icomplete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -322,8 +323,9 @@ mkIface_ hsc_env ************************************************************************ -} -mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch -mkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc +mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch +mkIfaceCompleteMatch cls = + IfaceCompleteMatch (map conLikeName (uniqDSetToList cls)) {- ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -324,11 +324,11 @@ data IfaceAnnotation type IfaceAnnTarget = AnnTarget OccName -data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName +newtype IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] instance Outputable IfaceCompleteMatch where - ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls - <+> dcolon <+> ppr ty + ppr (IfaceCompleteMatch cls) = text "COMPLETE" <> colon <+> ppr cls + @@ -2481,8 +2481,8 @@ instance Binary IfaceTyConParent where return $ IfDataInstance ax pr ty instance Binary IfaceCompleteMatch where - put_ bh (IfaceCompleteMatch cs ts) = put_ bh cs >> put_ bh ts - get bh = IfaceCompleteMatch <$> get bh <*> get bh + put_ bh (IfaceCompleteMatch cs) = put_ bh cs + get bh = IfaceCompleteMatch <$> get bh {- @@ -2638,7 +2638,7 @@ instance NFData IfaceConAlt where IfaceLitAlt lit -> lit `seq` () instance NFData IfaceCompleteMatch where - rnf (IfaceCompleteMatch f1 f2) = rnf f1 `seq` rnf f2 + rnf (IfaceCompleteMatch f1) = rnf f1 instance NFData IfaceRule where rnf (IfaceRule f1 f2 f3 f4 f5 f6 f7 f8) = ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -142,7 +142,7 @@ mkBootModDetailsTc hsc_env tcg_patsyns = pat_syns, tcg_insts = insts, tcg_fam_insts = fam_insts, - tcg_complete_matches = complete_sigs, + tcg_complete_matches = complete_matches, tcg_mod = this_mod } = -- This timing isn't terribly useful since the result isn't forced, but @@ -150,13 +150,13 @@ mkBootModDetailsTc hsc_env Err.withTiming dflags (text "CoreTidy"<+>brackets (ppr this_mod)) (const ()) $ - return (ModDetails { md_types = type_env' - , md_insts = insts' - , md_fam_insts = fam_insts - , md_rules = [] - , md_anns = [] - , md_exports = exports - , md_complete_sigs = complete_sigs + return (ModDetails { md_types = type_env' + , md_insts = insts' + , md_fam_insts = fam_insts + , md_rules = [] + , md_anns = [] + , md_exports = exports + , md_complete_matches = complete_matches }) where dflags = hsc_dflags hsc_env @@ -345,22 +345,22 @@ three places this is actioned: -} tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails) -tidyProgram hsc_env (ModGuts { mg_module = mod - , mg_exports = exports - , mg_rdr_env = rdr_env - , mg_tcs = tcs - , mg_insts = cls_insts - , mg_fam_insts = fam_insts - , mg_binds = binds - , mg_patsyns = patsyns - , mg_rules = imp_rules - , mg_anns = anns - , mg_complete_sigs = complete_sigs - , mg_deps = deps - , mg_foreign = foreign_stubs - , mg_foreign_files = foreign_files - , mg_hpc_info = hpc_info - , mg_modBreaks = modBreaks +tidyProgram hsc_env (ModGuts { mg_module = mod + , mg_exports = exports + , mg_rdr_env = rdr_env + , mg_tcs = tcs + , mg_insts = cls_insts + , mg_fam_insts = fam_insts + , mg_binds = binds + , mg_patsyns = patsyns + , mg_rules = imp_rules + , mg_anns = anns + , mg_complete_matches = complete_matches + , mg_deps = deps + , mg_foreign = foreign_stubs + , mg_foreign_files = foreign_files + , mg_hpc_info = hpc_info + , mg_modBreaks = modBreaks }) = Err.withTiming dflags @@ -465,13 +465,13 @@ tidyProgram hsc_env (ModGuts { mg_module = mod cg_modBreaks = modBreaks, cg_spt_entries = spt_entries }, - ModDetails { md_types = tidy_type_env, - md_rules = tidy_rules, - md_insts = tidy_cls_insts, - md_fam_insts = fam_insts, - md_exports = exports, - md_anns = anns, -- are already tidy - md_complete_sigs = complete_sigs + ModDetails { md_types = tidy_type_env, + md_rules = tidy_rules, + md_insts = tidy_cls_insts, + md_fam_insts = fam_insts, + md_exports = exports, + md_anns = anns, -- are already tidy + md_complete_matches = complete_matches }) } where ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -17,7 +17,7 @@ module GHC.IfaceToCore ( typecheckIfacesForMerging, typecheckIfaceForInstantiate, tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, - tcIfaceAnnotations, tcIfaceCompleteSigs, + tcIfaceAnnotations, tcIfaceCompleteMatches, tcIfaceExpr, -- Desired by HERMIT (#7683) tcIfaceGlobal, tcIfaceOneShot @@ -67,6 +67,7 @@ import GHC.Types.Name.Set import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Unit.Module import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet ( mkUniqDSet ) import GHC.Types.Unique.Supply import GHC.Utils.Outputable import GHC.Data.Maybe @@ -180,7 +181,7 @@ typecheckIface iface ; exports <- ifaceExportNames (mi_exports iface) -- Complete Sigs - ; complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + ; complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) -- Finished ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface), @@ -194,7 +195,7 @@ typecheckIface iface , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } } @@ -393,14 +394,14 @@ typecheckIfacesForMerging mod ifaces tc_env_var = rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) exports <- ifaceExportNames (mi_exports iface) - complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) return $ ModDetails { md_types = type_env , md_insts = insts , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } return (global_type_env, details) @@ -432,14 +433,14 @@ typecheckIfaceForInstantiate nsubst iface = rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) exports <- ifaceExportNames (mi_exports iface) - complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) return $ ModDetails { md_types = type_env , md_insts = insts , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } -- Note [Resolving never-exported Names] @@ -1147,11 +1148,14 @@ tcIfaceAnnTarget (ModuleTarget mod) = do ************************************************************************ -} -tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch] -tcIfaceCompleteSigs = mapM tcIfaceCompleteSig +tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch] +tcIfaceCompleteMatches = mapM tcIfaceCompleteMatch -tcIfaceCompleteSig :: IfaceCompleteMatch -> IfL CompleteMatch -tcIfaceCompleteSig (IfaceCompleteMatch ms t) = return (CompleteMatch ms t) +tcIfaceCompleteMatch :: IfaceCompleteMatch -> IfL CompleteMatch +tcIfaceCompleteMatch (IfaceCompleteMatch ms) = + mkUniqDSet <$> mapM (forkM doc . tcIfaceConLike) ms + where + doc = text "COMPLETE sig" <+> ppr ms {- ************************************************************************ @@ -1760,7 +1764,13 @@ tcIfaceDataCon :: Name -> IfL DataCon tcIfaceDataCon name = do { thing <- tcIfaceGlobal name ; case thing of AConLike (RealDataCon dc) -> return dc - _ -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) } + _ -> pprPanic "tcIfaceDataCon" (ppr name$$ ppr thing) } + +tcIfaceConLike :: Name -> IfL ConLike +tcIfaceConLike name = do { thing <- tcIfaceGlobal name + ; case thing of + AConLike cl -> return cl + _ -> pprPanic "tcIfaceConLike" (ppr name$$ ppr thing) } tcIfaceExtId :: Name -> IfL Id tcIfaceExtId name = do { thing <- tcIfaceGlobal name ===================================== compiler/GHC/IfaceToCore.hs-boot ===================================== @@ -11,9 +11,9 @@ import GHC.Core ( CoreRule ) import GHC.Driver.Types ( CompleteMatch ) import GHC.Types.Annotations ( Annotation ) -tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing -tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] -tcIfaceInst :: IfaceClsInst -> IfL ClsInst -tcIfaceFamInst :: IfaceFamInst -> IfL FamInst -tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] -tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch] +tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing +tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] +tcIfaceInst :: IfaceClsInst -> IfL ClsInst +tcIfaceFamInst :: IfaceFamInst -> IfL FamInst +tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] +tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch] ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -44,9 +44,8 @@ import GHC.Tc.Utils.TcMType import GHC.Core.Multiplicity import GHC.Core.FamInstEnv( normaliseType ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs ) -import GHC.Core.TyCon import GHC.Tc.Utils.TcType -import GHC.Core.Type (mkStrLitTy, tidyOpenType, splitTyConApp_maybe, mkCastTy) +import GHC.Core.Type (mkStrLitTy, tidyOpenType, mkCastTy) import GHC.Builtin.Types.Prim import GHC.Builtin.Types( mkBoxedTupleTy ) import GHC.Types.Id @@ -69,9 +68,9 @@ import GHC.Utils.Panic import GHC.Builtin.Names( ipClassName ) import GHC.Tc.Validity (checkValidType) import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Unique.Set import qualified GHC.LanguageExtensions as LangExt -import GHC.Core.ConLike import Control.Monad import Data.Foldable (find) @@ -197,112 +196,22 @@ tcTopBinds binds sigs -- The top level bindings are flattened into a giant -- implicitly-mutually-recursive LHsBinds - --- Note [Typechecking Complete Matches] --- Much like when a user bundled a pattern synonym, the result types of --- all the constructors in the match pragma must be consistent. --- --- If we allowed pragmas with inconsistent types then it would be --- impossible to ever match every constructor in the list and so --- the pragma would be useless. - - - - - --- This is only used in `tcCompleteSig`. We fold over all the conlikes, --- this accumulator keeps track of the first `ConLike` with a concrete --- return type. After fixing the return type, all other constructors with --- a fixed return type must agree with this. --- --- The fields of `Fixed` cache the first conlike and its return type so --- that we can compare all the other conlikes to it. The conlike is --- stored for error messages. --- --- `Nothing` in the case that the type is fixed by a type signature -data CompleteSigType = AcceptAny | Fixed (Maybe ConLike) TyCon - tcCompleteSigs :: [LSig GhcRn] -> TcM [CompleteMatch] tcCompleteSigs sigs = let - doOne :: Sig GhcRn -> TcM (Maybe CompleteMatch) - doOne c@(CompleteMatchSig _ _ lns mtc) - = fmap Just $ do - addErrCtxt (text "In" <+> ppr c) $ - case mtc of - Nothing -> infer_complete_match - Just tc -> check_complete_match tc - where - - checkCLTypes acc = foldM checkCLType (acc, []) (unLoc lns) - - infer_complete_match = do - (res, cls) <- checkCLTypes AcceptAny - case res of - AcceptAny -> failWithTc ambiguousError - Fixed _ tc -> return $ mkMatch cls tc - - check_complete_match tc_name = do - ty_con <- tcLookupLocatedTyCon tc_name - (_, cls) <- checkCLTypes (Fixed Nothing ty_con) - return $ mkMatch cls ty_con - - mkMatch :: [ConLike] -> TyCon -> CompleteMatch - mkMatch cls ty_con = CompleteMatch { - -- foldM is a left-fold and will have accumulated the ConLikes in - -- the reverse order. foldrM would accumulate in the correct order, - -- but would type-check the last ConLike first, which might also be - -- confusing from the user's perspective. Hence reverse here. - completeMatchConLikes = reverse (map conLikeName cls), - completeMatchTyCon = tyConName ty_con - } + doOne :: LSig GhcRn -> TcM (Maybe CompleteMatch) + -- We don't need to "type-check" COMPLETE signatures anymore; if their + -- combinations are invalid it will be found so at match sites. Hence we + -- keep '_mtc' only for backwards compatibility. + doOne (L loc c@(CompleteMatchSig _ext _src_txt (L _ ns) _mtc)) + = fmap Just $ setSrcSpan loc $ addErrCtxt (text "In" <+> ppr c) $ + mkUniqDSet <$> mapM (addLocM tcLookupConLike) ns doOne _ = return Nothing - ambiguousError :: SDoc - ambiguousError = - text "A type signature must be provided for a set of polymorphic" - <+> text "pattern synonyms." - - - -- See note [Typechecking Complete Matches] - checkCLType :: (CompleteSigType, [ConLike]) -> Located Name - -> TcM (CompleteSigType, [ConLike]) - checkCLType (cst, cs) n = do - cl <- addLocM tcLookupConLike n - let (_,_,_,_,_,_, res_ty) = conLikeFullSig cl - res_ty_con = fst <$> splitTyConApp_maybe res_ty - case (cst, res_ty_con) of - (AcceptAny, Nothing) -> return (AcceptAny, cl:cs) - (AcceptAny, Just tc) -> return (Fixed (Just cl) tc, cl:cs) - (Fixed mfcl tc, Nothing) -> return (Fixed mfcl tc, cl:cs) - (Fixed mfcl tc, Just tc') -> - if tc == tc' - then return (Fixed mfcl tc, cl:cs) - else case mfcl of - Nothing -> - addErrCtxt (text "In" <+> ppr cl) $ - failWithTc typeSigErrMsg - Just cl -> failWithTc (errMsg cl) - where - typeSigErrMsg :: SDoc - typeSigErrMsg = - text "Couldn't match expected type" - <+> quotes (ppr tc) - <+> text "with" - <+> quotes (ppr tc') - - errMsg :: ConLike -> SDoc - errMsg fcl = - text "Cannot form a group of complete patterns from patterns" - <+> quotes (ppr fcl) <+> text "and" <+> quotes (ppr cl) - <+> text "as they match different type constructors" - <+> parens (quotes (ppr tc) - <+> text "resp." - <+> quotes (ppr tc')) -- For some reason I haven't investigated further, the signatures come in -- backwards wrt. declaration order. So we reverse them here, because it makes -- a difference for incomplete match suggestions. - in mapMaybeM (addLocM doOne) (reverse sigs) -- process in declaration order + in mapMaybeM doOne $ reverse sigs tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id] -- A hs-boot file has only one BindGroup, and it only has type ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -45,12 +45,11 @@ module GHC.Tc.Types( IdBindingInfo(..), ClosedTypeId, RhsNames, IsGroupClosed(..), SelfBootInfo(..), - pprTcTyThingCategory, pprPECategory, CompleteMatch(..), + pprTcTyThingCategory, pprPECategory, CompleteMatch, -- Desugaring types DsM, DsLclEnv(..), DsGblEnv(..), - DsMetaEnv, DsMetaVal(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap, + DsMetaEnv, DsMetaVal(..), CompleteMatches, -- Template Haskell ThStage(..), SpliceType(..), PendingStuff(..), @@ -310,7 +309,7 @@ data DsGblEnv , ds_msgs :: IORef Messages -- Warning messages , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, -- possibly-imported things - , ds_complete_matches :: CompleteMatchMap + , ds_complete_matches :: CompleteMatches -- Additional complete pattern matches , ds_cc_st :: IORef CostCentreState -- Tracking indices for cost centre annotations @@ -602,7 +601,7 @@ data TcGblEnv tcg_static_wc :: TcRef WantedConstraints, -- ^ Wanted constraints of static forms. -- See Note [Constraints in static forms]. - tcg_complete_matches :: [CompleteMatch], + tcg_complete_matches :: !CompleteMatches, -- ^ Tracking indices for cost centre annotations tcg_cc_st :: TcRef CostCentreState ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -64,8 +64,8 @@ module GHC.Tc.Utils.Env( topIdLvl, isBrackStage, -- New Ids - newDFunName, newFamInstTyConName, - newFamInstAxiomName, + newDFunName, + newFamInstTyConName, newFamInstAxiomName, mkStableIdFromString, mkStableIdFromName, mkWrapperName ) where ===================================== docs/users_guide/exts/pragmas.rst ===================================== @@ -887,29 +887,6 @@ modules. ``COMPLETE`` pragmas should be thought of as asserting a universal truth about a set of patterns and as a result, should not be used to silence context specific incomplete match warnings. -When specifying a ``COMPLETE`` pragma, the result types of all patterns must -be consistent with each other. This is a sanity check as it would be impossible -to match on all the patterns if the types were inconsistent. - -The result type must also be unambiguous. Usually this can be inferred but -when all the pattern synonyms in a group are polymorphic in the constructor -the user must provide a type signature. :: - - class LL f where - go :: f a -> () - - instance LL [] where - go _ = () - - pattern T :: LL f => f a - pattern T <- (go -> ()) - - {-# COMPLETE T :: [] #-} - - -- No warning - foo :: [a] -> Int - foo T = 5 - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/pmcheck/complete_sigs/completesig15.hs → testsuite/tests/pmcheck/complete_sigs/T14422.hs ===================================== @@ -10,3 +10,6 @@ pattern P :: C f => f a pattern P <- (foo -> ()) {-# COMPLETE P #-} + +f :: C f => f a -> () +f P = () -- A complete match ===================================== testsuite/tests/pmcheck/complete_sigs/T18277.hs ===================================== @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +type List = [] + +pattern DefinitelyAString :: String -> String +pattern DefinitelyAString x = x +{-# COMPLETE DefinitelyAString #-} + +f :: String -> String +f (DefinitelyAString x) = x ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -1,7 +1,7 @@ test('completesig01', normal, compile, ['']) test('completesig02', normal, compile, ['']) test('Completesig03', normal, multimod_compile, ['Completesig03', '-Wall']) -test('completesig04', normal, compile_fail, ['']) +test('completesig04', normal, compile, ['-Wincomplete-patterns']) test('completesig05', normal, compile, ['']) test('completesig06', normal, compile, ['']) test('completesig07', normal, compile, ['']) @@ -12,7 +12,6 @@ test('completesig11', normal, compile, ['']) test('completesig12', normal, compile, ['']) test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) -test('completesig15', normal, compile_fail, ['']) test('T13021', normal, compile, ['']) test('T13363a', normal, compile, ['']) test('T13363b', normal, compile, ['']) @@ -22,6 +21,8 @@ test('T13965', normal, compile, ['']) test('T14059a', normal, compile, ['']) test('T14059b', expect_broken('14059'), compile, ['']) test('T14253', normal, compile, ['']) +test('T14422', normal, compile, ['']) test('T14851', normal, compile, ['']) test('T17149', normal, compile, ['']) test('T17386', normal, compile, ['']) +test('T18277', normal, compile, ['']) ===================================== testsuite/tests/pmcheck/complete_sigs/completesig04.hs ===================================== @@ -1,6 +1,12 @@ --- Test that a COMPLETE pragma over constructors of different types fails. +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +-- Test that a COMPLETE pragma over constructors of different types is a valid +-- declaration, but that it's not suggested in any warning. module TyMismatch where -data E = L | R +data T = A | B | C -{-# COMPLETE Just, L #-} +{-# COMPLETE Just, A #-} + +f A = () -- should not suggest 'Just' + +g (Just _) = () -- should not suggest 'A' ===================================== testsuite/tests/pmcheck/complete_sigs/completesig04.stderr ===================================== @@ -1,4 +1,11 @@ -completesig04.hs:6:1: error: - • Cannot form a group of complete patterns from patterns ‘Just’ and ‘L’ as they match different type constructors (‘Maybe’ resp. ‘E’) - • In {-# COMPLETE Just, L #-} +completesig04.hs:10:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: + Patterns not matched: + B + C + +completesig04.hs:12:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘g’: Patterns not matched: Nothing ===================================== testsuite/tests/pmcheck/complete_sigs/completesig15.stderr deleted ===================================== @@ -1,4 +0,0 @@ - -completesig15.hs:12:1: error: - • A type signature must be provided for a set of polymorphic pattern synonyms. - • In {-# COMPLETE P #-} ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -88,7 +88,7 @@ test('T17112', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17207', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17207b', expect_broken(17207), compile, +test('T17207b', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17208', expect_broken(17208), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56336b739d55dadf1f53d829e84ab1dc5e8e420c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56336b739d55dadf1f53d829e84ab1dc5e8e420c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 13:19:11 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 03 Sep 2020 09:19:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18645 Message-ID: <5f50ed4f19163_80b3f84941e4b0c103939f1@gitlab.haskell.org.mail> Sebastian Graf pushed new branch wip/T18645 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18645 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 13:35:46 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Thu, 03 Sep 2020 09:35:46 -0400 Subject: [Git][ghc/ghc][wip/wire-in-constraint-tuples] Wire in constraint tuples Message-ID: <5f50f13225059_80b3f84960d77f8103972f@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/wire-in-constraint-tuples at Glasgow Haskell Compiler / GHC Commits: 2b241a0d by Ryan Scott at 2020-09-03T09:29:59-04:00 Wire in constraint tuples This wires in the definitions of the constraint tuple classes. The key changes are in: * `GHC.Builtin.Types`, where the `mk_ctuple` function is used to define constraint tuple type constructors, data constructors, and superclass selector functions, and * `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for constraint tuple type and data constructors, we now must wire in the superclass selector functions. Luckily, this proves to be not that challenging. See the newly added comments. Historical note: constraint tuples used to be wired-in until about five years ago, when commit 130e93aab220bdf14d08028771f83df210da340b turned them into known-key names. This was done as part of a larger refactor to reduce the number of special cases for constraint tuples, but the commit message notes that the main reason that constraint tuples were made known-key (as opposed to boxed/unboxed tuples, which are wired in) is because it was awkward to wire in the superclass selectors. This commit solves the problem of wiring in superclass selectors. Fixes #18635. ------------------------- Metric Decrease: T10421 T12150 T12227 T12234 T12425 T13056 T13253-spj T18282 T18304 T5321FD T5321Fun T5837 T9961 Metric Decrease (test_env='x86_64-linux-deb9-unreg-hadrian') T12707 ------------------------- - - - - - 5 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/HsType.hs Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -80,9 +80,10 @@ module GHC.Builtin.Types ( unboxedTupleKind, unboxedSumKind, -- ** Constraint tuples - cTupleTyConName, cTupleTyConNames, isCTupleTyConName, + cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName, cTupleTyConNameArity_maybe, - cTupleDataConName, cTupleDataConNames, + cTupleDataCon, cTupleDataConName, cTupleDataConNames, + cTupleSelId, cTupleSelIdName, -- * Any anyTyCon, anyTy, anyTypeOfKind, @@ -174,10 +175,9 @@ import GHC.Core.Class ( Class, mkClass ) import GHC.Types.Name.Reader import GHC.Types.Name as Name import GHC.Types.Name.Env ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF ) -import GHC.Types.Name.Set ( NameSet, mkNameSet, elemNameSet ) import GHC.Types.Basic import GHC.Types.ForeignCall -import GHC.Types.SrcLoc ( noSrcSpan ) +import GHC.Types.Unique.Set import Data.Array import GHC.Data.FastString import GHC.Data.BooleanFormula ( mkAnd ) @@ -723,20 +723,23 @@ Note [How tuples work] See also Note [Known-key names] in GHC.Builtin.Names but no actual declaration and no info table * ConstraintTuples - - Are known-key rather than wired-in. Reason: it's awkward to - have all the superclass selectors wired-in. + - A wired-in type. - Declared as classes in GHC.Classes, e.g. class (c1,c2) => (c1,c2) - Given constraints: the superclasses automatically become available - Wanted constraints: there is a built-in instance instance (c1,c2) => (c1,c2) - See GHC.Tc.Solver.Interact.matchCTuple + See GHC.Tc.Instance.Class.matchCTuple - Currently just go up to 62; beyond that you have to use manual nesting - Their OccNames look like (%,,,%), so they can easily be distinguished from term tuples. But (following Haskell) we pretty-print saturated constraint tuples with round parens; see BasicTypes.tupleParens. + - Unlike BoxedTuples and UnboxedTuples, which only wire + in type constructors and data constructors, ConstraintTuples also wire in + superclass selector functions. For instance, $p1(%,%) and $p2(%,%) are + the selectors for the binary constraint tuple. * In quite a lot of places things are restricted just to BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish @@ -914,26 +917,26 @@ mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)" commas :: Arity -> String commas ar = take (ar-1) (repeat ',') +cTupleTyCon :: Arity -> TyCon +cTupleTyCon i + | i > mAX_CTUPLE_SIZE = fstOf3 (mk_ctuple i) -- Build one specially + | otherwise = fstOf3 (cTupleArr ! i) + cTupleTyConName :: Arity -> Name -cTupleTyConName arity - = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES - (mkCTupleOcc tcName arity) noSrcSpan +cTupleTyConName a = tyConName (cTupleTyCon a) cTupleTyConNames :: [Name] cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) -cTupleTyConNameSet :: NameSet -cTupleTyConNameSet = mkNameSet cTupleTyConNames +cTupleTyConKeys :: UniqSet Unique +cTupleTyConKeys = mkUniqSet $ map getUnique cTupleTyConNames isCTupleTyConName :: Name -> Bool --- Use Type.isCTupleClass where possible isCTupleTyConName n = ASSERT2( isExternalName n, ppr n ) - nameModule n == gHC_CLASSES - && n `elemNameSet` cTupleTyConNameSet + getUnique n `elementOfUniqSet` cTupleTyConKeys -- | If the given name is that of a constraint tuple, return its arity. --- Note that this is inefficient. cTupleTyConNameArity_maybe :: Name -> Maybe Arity cTupleTyConNameArity_maybe n | not (isCTupleTyConName n) = Nothing @@ -943,14 +946,46 @@ cTupleTyConNameArity_maybe n -- case, we have to adjust accordingly our calculated arity. adjustArity a = if a > 0 then a + 1 else a +cTupleDataCon :: Arity -> DataCon +cTupleDataCon i + | i > mAX_CTUPLE_SIZE = sndOf3 (mk_ctuple i) -- Build one specially + | otherwise = sndOf3 (cTupleArr ! i) + cTupleDataConName :: Arity -> Name -cTupleDataConName arity - = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES - (mkCTupleOcc dataName arity) noSrcSpan +cTupleDataConName i = dataConName (cTupleDataCon i) cTupleDataConNames :: [Name] cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE]) +cTupleSelId :: ConTag -- Superclass position + -> Arity -- Arity + -> Id +cTupleSelId sc_pos arity + | sc_pos > arity + = panic ("cTupleSelId: index out of bounds: superclass position: " + ++ show sc_pos ++ " > arity " ++ show arity) + + | sc_pos <= 0 + = panic ("cTupleSelId: Superclass positions start from 1. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity < 2 + = panic ("cTupleSelId: Arity starts from 2. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity > mAX_CTUPLE_SIZE + = thdOf3 (mk_ctuple arity) ! (sc_pos - 1) -- Build one specially + + | otherwise + = thdOf3 (cTupleArr ! arity) ! (sc_pos - 1) + +cTupleSelIdName :: ConTag -- Superclass position + -> Arity -- Arity + -> Name +cTupleSelIdName sc_pos arity = idName (cTupleSelId sc_pos arity) + tupleTyCon :: Boxity -> Arity -> TyCon tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i) -- Build one specially tupleTyCon Boxed i = fst (boxedTupleArr ! i) @@ -976,6 +1011,20 @@ boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon) boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]] unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]] +-- | Cached type constructors, data constructors, and superclass selectors for +-- constraint tuples. The outer array is indexed by the arity of the constraint +-- tuple and the inner array is indexed by the superclass position. +cTupleArr :: Array Int (TyCon, DataCon, Array Int Id) +cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZE]] + -- Although GHC does not make use of unary constraint tuples + -- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType), + -- this array creates one anyway. This is primarily motivated by the fact + -- that (1) the indices of an Array must be contiguous, and (2) we would like + -- the index of a constraint tuple in this Array to correspond to its Arity. + -- We could envision skipping over the unary constraint tuple and having index + -- 1 correspond to a 2-constraint tuple (and so on), but that's more + -- complicated than it's worth. + -- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed -- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type -- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep @@ -1040,6 +1089,45 @@ mk_tuple Unboxed arity = (tycon, tuple_con) tc_uniq = mkTupleTyConUnique boxity arity dc_uniq = mkTupleDataConUnique boxity arity +mk_ctuple :: Arity -> (TyCon, DataCon, Array ConTagZ Id) +mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr) + where + tycon = mkClassTyCon tc_name binders roles + rhs klass + (mkPrelTyConRepName tc_name) + + klass = mk_ctuple_class tycon sc_theta sc_sel_ids + tuple_con = pcDataConW dc_name tvs (map unrestricted sc_theta) tycon + + binders = mkTemplateAnonTyConBinders (replicate arity constraintKind) + roles = replicate arity Nominal + rhs = TupleTyCon{data_con = tuple_con, tup_sort = ConstraintTuple} + + modu = gHC_CLASSES + tc_name = mkWiredInName modu (mkCTupleOcc tcName arity) tc_uniq + (ATyCon tycon) BuiltInSyntax + dc_name = mkWiredInName modu (mkCTupleOcc dataName arity) dc_uniq + (AConLike (RealDataCon tuple_con)) BuiltInSyntax + tc_uniq = mkCTupleTyConUnique arity + dc_uniq = mkCTupleDataConUnique arity + + tvs = binderVars binders + sc_theta = map mkTyVarTy tvs + sc_sel_ids = [mk_sc_sel_id sc_pos | sc_pos <- [0..arity-1]] + sc_sel_ids_arr = listArray (0,arity-1) sc_sel_ids + + mk_sc_sel_id sc_pos = + let sc_sel_id_uniq = mkCTupleSelIdUnique sc_pos arity + sc_sel_id_occ = mkCTupleOcc tcName arity + sc_sel_id_name = mkWiredInIdName + gHC_CLASSES + (occNameFS (mkSuperDictSelOcc sc_pos sc_sel_id_occ)) + sc_sel_id_uniq + sc_sel_id + sc_sel_id = mkDictSelId sc_sel_id_name klass + + in sc_sel_id + unitTyCon :: TyCon unitTyCon = tupleTyCon Boxed 0 @@ -1248,7 +1336,10 @@ mk_class tycon sc_pred sc_sel_id = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon - +mk_ctuple_class :: TyCon -> ThetaType -> [Id] -> Class +mk_ctuple_class tycon sc_theta sc_sel_ids + = mkClass (tyConName tycon) (tyConTyVars tycon) [] sc_theta sc_sel_ids + [] [] (mkAnd []) tycon {- ********************************************************************* * * ===================================== compiler/GHC/Builtin/Types.hs-boot ===================================== @@ -64,8 +64,10 @@ promotedTupleDataCon :: Boxity -> Arity -> TyCon tupleDataCon :: Boxity -> Arity -> DataCon tupleTyCon :: Boxity -> Arity -> TyCon +cTupleDataCon :: Arity -> DataCon cTupleDataConName :: Arity -> Name cTupleTyConName :: Arity -> Name +cTupleSelIdName :: ConTag -> Arity -> Name sumDataCon :: ConTag -> Arity -> DataCon sumTyCon :: Arity -> TyCon ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -22,6 +22,7 @@ module GHC.Builtin.Uniques -- *** Constraint , mkCTupleTyConUnique , mkCTupleDataConUnique + , mkCTupleSelIdUnique -- ** Making built-in uniques , mkAlphaTyVarUnique @@ -79,8 +80,9 @@ knownUniqueName u = '5' -> Just $ getTupleTyConName Unboxed n '7' -> Just $ getTupleDataConName Boxed n '8' -> Just $ getTupleDataConName Unboxed n + 'j' -> Just $ getCTupleSelIdName n 'k' -> Just $ getCTupleTyConName n - 'm' -> Just $ getCTupleDataConUnique n + 'm' -> Just $ getCTupleDataConName n _ -> Nothing where (tag, n) = unpkUnique u @@ -158,6 +160,21 @@ getUnboxedSumName n -------------------------------------------------- -- Constraint tuples +-- +-- Constraint tuples, like boxed and unboxed tuples, have their type and data +-- constructor Uniques wired in +-- (see Note [Uniques for tuple type and data constructors]). In addition, the +-- superclass selectors for each constraint tuple have wired-in Uniques. A +-- constraint tuple of arity n has n different selectors (e.g., the binary +-- constraint tuple has selectors $p1(%,%) and $p2(%,%)). +-- +-- The encoding of these selectors' Uniques takes somewhat resembles the +-- encoding for unboxed sums (see above). The integral part of the Unique +-- is broken up into bitfields for the arity and the position of the +-- superclass. Given a selector for a constraint tuple with arity n +-- (zero-based) and position k (where 1 <= k <= n), its Unique will look like: +-- +-- 00000000 nnnnnnnn kkkkkkkk mkCTupleTyConUnique :: Arity -> Unique mkCTupleTyConUnique a = mkUnique 'k' (2*a) @@ -165,6 +182,13 @@ mkCTupleTyConUnique a = mkUnique 'k' (2*a) mkCTupleDataConUnique :: Arity -> Unique mkCTupleDataConUnique a = mkUnique 'm' (3*a) +mkCTupleSelIdUnique :: ConTagZ -> Arity -> Unique +mkCTupleSelIdUnique sc_pos arity + | sc_pos >= arity + = panic ("mkCTupleSelIdUnique: " ++ show sc_pos ++ " >= " ++ show arity) + | otherwise + = mkUnique 'j' (arity `shiftL` 8 + sc_pos) + getCTupleTyConName :: Int -> Name getCTupleTyConName n = case n `divMod` 2 of @@ -172,14 +196,20 @@ getCTupleTyConName n = (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity _ -> panic "getCTupleTyConName: impossible" -getCTupleDataConUnique :: Int -> Name -getCTupleDataConUnique n = +getCTupleDataConName :: Int -> Name +getCTupleDataConName n = case n `divMod` 3 of (arity, 0) -> cTupleDataConName arity - (_arity, 1) -> panic "getCTupleDataConName: no worker" + (arity, 1) -> getName $ dataConWrapId $ cTupleDataCon arity (arity, 2) -> mkPrelTyConRepName $ cTupleDataConName arity _ -> panic "getCTupleDataConName: impossible" +getCTupleSelIdName :: Int -> Name +getCTupleSelIdName n = cTupleSelIdName (sc_pos + 1) arity + where + arity = n `shiftR` 8 + sc_pos = n .&. 0xff + -------------------------------------------------- -- Normal tuples @@ -230,6 +260,7 @@ Allocation of unique supply characters: d desugarer f AbsC flattener g SimplStg + j constraint tuple superclass selectors k constraint tuple tycons m constraint tuple datacons n Native codegen ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1204,10 +1204,9 @@ tcTupleTyCon :: Bool -- True <=> typechecking a *type* (vs. an expr) -> IfL TyCon tcTupleTyCon in_type sort arity = case sort of - ConstraintTuple -> do { thing <- tcIfaceGlobal (cTupleTyConName arity) - ; return (tyThingTyCon thing) } - BoxedTuple -> return (tupleTyCon Boxed arity) - UnboxedTuple -> return (tupleTyCon Unboxed arity') + ConstraintTuple -> return (cTupleTyCon arity) + BoxedTuple -> return (tupleTyCon Boxed arity) + UnboxedTuple -> return (tupleTyCon Unboxed arity') where arity' | in_type = arity `div` 2 | otherwise = arity -- in expressions, we only have term args ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1269,8 +1269,8 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do | arity > mAX_CTUPLE_SIZE -> failWith (bigConstraintTuple arity) | otherwise - -> do tycon <- tcLookupTyCon (cTupleTyConName arity) - check_expected_kind (mkTyConApp tycon tau_tys) constraintKind + -> let tycon = cTupleTyCon arity in + check_expected_kind (mkTyConApp tycon tau_tys) constraintKind BoxedTuple -> do let tycon = tupleTyCon Boxed arity checkWiredInTyCon tycon View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b241a0deacd9ebf782b645c684de5a79a513a30 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2b241a0deacd9ebf782b645c684de5a79a513a30 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 16:31:51 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 03 Sep 2020 12:31:51 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Turn on -XMonoLocalBinds by default (#18430) Message-ID: <5f511a77d9477_80b3f8486957bf4104379fa@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 63c66c41 by Ben Gamari at 2020-09-03T12:31:42-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - b86cf1a8 by Kathryn Spiers at 2020-09-03T12:31:43-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 12 changed files: - aclocal.m4 - compiler/GHC/Builtin/Names.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/SysTools.hs - compiler/ghc.cabal.in - docs/users_guide/expected-undocumented-flags.txt - libraries/base/Data/OldList.hs - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs Changes: ===================================== aclocal.m4 ===================================== @@ -447,25 +447,40 @@ AC_DEFUN([GET_ARM_ISA], #endif] )], [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7]) - ARM_ISA=ARMv6 - AC_COMPILE_IFELSE([ - AC_LANG_PROGRAM( - [], - [#if defined(__VFP_FP__) - return 0; - #else - no vfp - #endif] - )], - [changequote(, )dnl - ARM_ISA_EXT="[VFPv2]" - changequote([, ])dnl - ], - [changequote(, )dnl - ARM_ISA_EXT="[]" - changequote([, ])dnl - ] - )], + if grep -q Raspbian /etc/issue && uname -m | grep -q armv7; then + # Raspbian unfortunately makes some extremely questionable + # packaging decisions, configuring gcc to compile for ARMv6 + # despite the fact that the RPi4 is ARMv8. As ARMv8 doesn't + # support all instructions supported by ARMv6 this can + # break. Work around this by checking uname to verify + # that we aren't running on armv7. + # See #17856. + AC_MSG_NOTICE([Found compiler which claims to target ARMv6 running on ARMv7, assuming this is ARMv7 on Raspbian (see T17856)]) + ARM_ISA=ARMv7 + changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + else + ARM_ISA=ARMv6 + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM( + [], + [#if defined(__VFP_FP__) + return 0; + #else + no vfp + #endif] + )], + [changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + ], + [changequote(, )dnl + ARM_ISA_EXT="[]" + changequote([, ])dnl + ] + ) + fi], [changequote(, )dnl ARM_ISA=ARMv7 ARM_ISA_EXT="[VFPv3,NEON]" ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -116,35 +116,6 @@ known keys. See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys) in GHC.Builtin.Types. -Note [The integer library] -~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Clearly, we need to know the names of various definitions of the integer -library, e.g. the type itself, `mkInteger` etc. But there are two possible -implementations of the integer library: - - * integer-gmp (fast, but uses libgmp, which may not be available on all - targets and is GPL licensed) - * integer-simple (slow, but pure Haskell and BSD-licensed) - -We want the compiler to work with either one. The way we achieve this is: - - * When compiling the integer-{gmp,simple} library, we pass - -this-unit-id integer-wired-in - to GHC (see the cabal file libraries/integer-{gmp,simple}. - * This way, GHC can use just this UnitID (see Module.integerUnitId) when - generating code, and the linker will succeed. - -Unfortuately, the abstraction is not complete: When using integer-gmp, we -really want to use the S# constructor directly. This is controlled by -the `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use -this constructor directly (see CorePrep.lookupIntegerSDataConName) - -When GHC reads the package data base, it (internally only) pretends it has UnitId -`integer-wired-in` instead of the actual UnitId (which includes the version -number); just like for `base` and other packages, as described in -Note [Wired-in units] in GHC.Unit.Module. This is done in -GHC.Unit.State.findWiredInUnits. -} {-# LANGUAGE CPP #-} ===================================== compiler/GHC/CmmToAsm/Reg/Linear.hs ===================================== @@ -205,7 +205,7 @@ regAlloc _ (CmmProc _ _ _ _) -- an entry in the block map or it is the first block. -- linearRegAlloc - :: Instruction instr + :: forall instr. Instruction instr => NCGConfig -> [BlockId] -- ^ entry points -> BlockMap RegSet @@ -231,6 +231,8 @@ linearRegAlloc config entry_ids block_live sccs ArchJavaScript -> panic "linearRegAlloc ArchJavaScript" ArchUnknown -> panic "linearRegAlloc ArchUnknown" where + go :: (FR regs, Outputable regs) + => regs -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int) go f = linearRegAlloc' config f entry_ids block_live sccs platform = ncgPlatform config @@ -973,4 +975,3 @@ loadTemp vreg (ReadMem slot) hreg spills loadTemp _ _ _ spills = return spills - ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2290,6 +2290,7 @@ lintCoercion this@(AxiomRuleCo ax cos) Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] Just _ -> return (AxiomRuleCo ax cos') } where + err :: forall a. String -> [SDoc] -> LintM a err m xs = failWithL $ hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -1909,7 +1909,7 @@ completeCall env var cont log_inlining $ sep [text "Inlining done:", nest 4 (ppr var)] | otherwise - = liftIO $ log_inlining $ + = log_inlining $ sep [text "Inlining done: " <> ppr var, nest 4 (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding), text "Cont: " <+> ppr cont])] ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -1373,7 +1373,8 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup -- -- There better had not be any cyclic groups here -- we check for them. upsweep - :: GhcMonad m + :: forall m + . GhcMonad m => Maybe Messager -> HomePackageTable -- ^ HPT from last time round (pruned) -> StableModules -- ^ stable modules (see checkStability) @@ -1415,8 +1416,7 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do return (Failed, done') upsweep' - :: GhcMonad m - => HomePackageTable + :: HomePackageTable -> ModuleGraph -> [SCC ModSummary] -> Int ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -1134,6 +1134,7 @@ unload_wkr hsc_env keep_linkables pls at PersistentLinkerState{..} = do -- Note that we want to remove all *local* -- (i.e. non-isExternal) names too (these are the -- temporary bindings from the command line). + keep_name :: (Name, a) -> Bool keep_name (n,_) = isExternalName n && nameModule n `elemModuleSet` bcos_retained ===================================== compiler/GHC/SysTools.hs ===================================== @@ -138,15 +138,17 @@ lazyInitLlvmConfig :: String -> IO LlvmConfig lazyInitLlvmConfig top_dir = unsafeInterleaveIO $ do -- see Note [LLVM configuration] - targets <- readAndParse "llvm-targets" mkLlvmTarget - passes <- readAndParse "llvm-passes" id - return $ LlvmConfig { llvmTargets = targets, llvmPasses = passes } + targets <- readAndParse "llvm-targets" + passes <- readAndParse "llvm-passes" + return $ LlvmConfig { llvmTargets = fmap mkLlvmTarget <$> targets, + llvmPasses = passes } where - readAndParse name builder = + readAndParse :: Read a => String -> IO a + readAndParse name = do let llvmConfigFile = top_dir name llvmConfigStr <- readFile llvmConfigFile case maybeReadFuzzy llvmConfigStr of - Just s -> return (fmap builder <$> s) + Just s -> return s Nothing -> pgmError ("Can't parse " ++ show llvmConfigFile) mkLlvmTarget :: (String, String, String) -> LlvmTarget ===================================== compiler/ghc.cabal.in ===================================== @@ -153,6 +153,7 @@ Library NoImplicitPrelude ,BangPatterns ,ScopedTypeVariables + ,MonoLocalBinds Exposed-Modules: GHC.Iface.Ext.Types ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -101,8 +101,6 @@ -fimplicit-params -fimplicit-prelude -firrefutable-tuples --fkill-absence --fkill-one-shot -fmax-errors -fmax-pmcheck-iterations -fmono-pat-binds ===================================== libraries/base/Data/OldList.hs ===================================== @@ -550,7 +550,13 @@ intercalate xs xss = concat (intersperse xs xss) transpose :: [[a]] -> [[a]] transpose [] = [] transpose ([] : xss) = transpose xss -transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss]) +transpose ((x:xs) : xss) = (x : hds) : transpose (xs : tls) + where + -- We tie the calculations of heads and tails together + -- to prevent heads from leaking into tails and vice versa. + -- unzip makes the selector thunk arrangements we need to + -- ensure everything gets cleaned up properly. + (hds, tls) = unzip [(hd, tl) | (hd:tl) <- xss] -- | The 'partition' function takes a predicate a list and returns ===================================== libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs ===================================== @@ -57,9 +57,6 @@ module GHC.Integer.GMP.Internals , bigNatToInt , bigNatToWord , indexBigNat# - , importBigNatFromByteArray - , exportBigNatToMutableByteArray - -- ** 'BigNat' arithmetic operations , plusBigNat @@ -112,9 +109,17 @@ module GHC.Integer.GMP.Internals -- ** Export , exportBigNatToAddr + , exportIntegerToAddr + + , exportBigNatToMutableByteArray + , exportIntegerToMutableByteArray -- ** Import , importBigNatFromAddr + , importIntegerFromAddr + + , importBigNatFromByteArray + , importIntegerFromByteArray ) where import GHC.Integer @@ -373,6 +378,18 @@ exportBigNatToAddr (BN# b) addr endian = IO \s -> case B.bigNatToAddr# b addr endian s of (# s', w #) -> (# s', W# w #) +{-# DEPRECATED importIntegerFromAddr "Use integerFromAddr# instead" #-} +importIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer +importIntegerFromAddr addr sz endian = IO \s -> + case I.integerFromAddr# sz addr endian s of + (# s', i #) -> (# s', i #) + +{-# DEPRECATED exportIntegerToAddr "Use integerToAddr# instead" #-} +exportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word +exportIntegerToAddr i addr endian = IO \s -> + case I.integerToAddr# i addr endian s of + (# s', w #) -> (# s', W# w #) + wordToBigNat :: Word# -> BigNat wordToBigNat w = BN# (B.bigNatFromWord# w) @@ -398,3 +415,13 @@ importBigNatFromByteArray ba off sz endian = case runRW# (B.bigNatFromByteArray# exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word exportBigNatToMutableByteArray (BN# ba) mba off endian = IO (\s -> case B.bigNatToMutableByteArray# ba mba off endian s of (# s', r #) -> (# s', W# r #)) + +{-# DEPRECATED importIntegerFromByteArray "Use integerFromByteArray# instead" #-} +importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer +importIntegerFromByteArray ba off sz endian = case runRW# (I.integerFromByteArray# sz ba off endian) of + (# _, r #) -> r + +{-# DEPRECATED exportIntegerToMutableByteArray "Use integerToMutableByteArray# instead" #-} +exportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word +exportIntegerToMutableByteArray i mba off endian = IO (\s -> case I.integerToMutableByteArray# i mba off endian s of + (# s', r #) -> (# s', W# r #)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab44b2abcbbf85c681f0e578b6dffe20efbe2e98...b86cf1a85c4069707753f1799b83269e26dbfe14 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ab44b2abcbbf85c681f0e578b6dffe20efbe2e98...b86cf1a85c4069707753f1799b83269e26dbfe14 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 17:22:02 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Thu, 03 Sep 2020 13:22:02 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] Fix up after rebasing to bring in XRec Message-ID: <5f51263a7f39b_80b3f8486a2fd88104446ba@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 7d563bb0 by Alan Zimmerman at 2020-09-03T18:21:37+01:00 Fix up after rebasing to bring in XRec Main thing is to make type instance XRec (GhcPass p) a = GenLocated (Anno a) a type family Anno a = b But this has massive implications. - - - - - 22 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Pat.hs-boot - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d563bb0248bcbc0056701631f3da22f8a6352c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7d563bb0248bcbc0056701631f3da22f8a6352c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 18:41:19 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Thu, 03 Sep 2020 14:41:19 -0400 Subject: [Git][ghc/ghc][wip/wire-in-constraint-tuples] 23 commits: base: Better error message on invalid getSystemTimerManager call Message-ID: <5f5138cf509db_80b3f8446ea19741045534b@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/wire-in-constraint-tuples at Glasgow Haskell Compiler / GHC Commits: 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - dcdf7848 by Ryan Scott at 2020-09-03T14:37:46-04:00 Wire in constraint tuples This wires in the definitions of the constraint tuple classes. The key changes are in: * `GHC.Builtin.Types`, where the `mk_ctuple` function is used to define constraint tuple type constructors, data constructors, and superclass selector functions, and * `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for constraint tuple type and data constructors, we now must wire in the superclass selector functions. Luckily, this proves to be not that challenging. See the newly added comments. Historical note: constraint tuples used to be wired-in until about five years ago, when commit 130e93aab220bdf14d08028771f83df210da340b turned them into known-key names. This was done as part of a larger refactor to reduce the number of special cases for constraint tuples, but the commit message notes that the main reason that constraint tuples were made known-key (as opposed to boxed/unboxed tuples, which are wired in) is because it was awkward to wire in the superclass selectors. This commit solves the problem of wiring in superclass selectors. Fixes #18635. ------------------------- Metric Decrease: T10421 T12150 T12227 T12234 T12425 T13056 T13253-spj T18282 T18304 T5321FD T5321Fun T5837 T9961 Metric Decrease (test_env='x86_64-linux-deb9-unreg-hadrian'): T12707 ------------------------- - - - - - 30 changed files: - .gitignore - aclocal.m4 - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Rep.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Hs/Lit.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Ext/Debug.hs - compiler/GHC/Iface/Ext/Types.hs - compiler/GHC/Iface/Ext/Utils.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Recomp.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/SysTools.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b241a0deacd9ebf782b645c684de5a79a513a30...dcdf784827c632b61c3ec0e551578b7d90f17df6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b241a0deacd9ebf782b645c684de5a79a513a30...dcdf784827c632b61c3ec0e551578b7d90f17df6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 21:04:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Sep 2020 17:04:58 -0400 Subject: [Git][ghc/ghc][wip/stgMalloc] rts: Consistently use stgMallocBytes instead of malloc Message-ID: <5f515a7a39070_80b3f84675e8adc104646f4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/stgMalloc at Glasgow Haskell Compiler / GHC Commits: 18e7310c by GHC GitLab CI at 2020-09-03T21:04:21+00:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 5 changed files: - rts/linker/PEi386.c - rts/win32/IOManager.c - rts/win32/OSThreads.c - rts/win32/WorkQueue.c - rts/xxhash.c Changes: ===================================== rts/linker/PEi386.c ===================================== @@ -735,7 +735,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) error: stgFree(buf); - char* errormsg = malloc(sizeof(char) * 80); + char* errormsg = stgMallocBytes(sizeof(char) * 80, "addDLL_PEi386"); snprintf(errormsg, 80, "addDLL: %" PATH_FMT " or dependencies not loaded. (Win32 error %lu)", dll_name, GetLastError()); /* LoadLibrary failed; return a ptr to the error msg. */ return errormsg; @@ -745,7 +745,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) { const unsigned int init_buf_size = 1024; unsigned int bufsize = init_buf_size; - wchar_t* result = malloc(sizeof(wchar_t) * bufsize); + wchar_t* result = stgMallocBytes(sizeof(wchar_t) * bufsize, "findSystemLibrary_PEi386"); DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL); if (wResult > bufsize) { @@ -755,7 +755,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) if (!wResult) { - free(result); + stgFree(result); return NULL; } @@ -773,7 +773,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) int bufsize = init_buf_size; // Make sure the path is an absolute path - WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* abs_path = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(1)"); DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL); if (!wResult){ IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError())); @@ -791,7 +791,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) else { warnMissingKBLibraryPaths(); - WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* str = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(2)"); wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); if (wResult > init_buf_size) { @@ -804,7 +804,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) } bufsize = wResult + 2 + pathlen(abs_path); - wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize); + wchar_t* newPath = stgMallocBytes(sizeof(wchar_t) * bufsize, "addLibrarySearchPath_PEi386(3)"); wcscpy(newPath, abs_path); wcscat(newPath, L";"); @@ -813,19 +813,19 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); } - free(newPath); - free(abs_path); + stgFree(newPath); + stgFree(abs_path); return str; } if (!result) { sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); - free(abs_path); + stgFree(abs_path); return NULL; } - free(abs_path); + stgFree(abs_path); return result; } ===================================== rts/win32/IOManager.c ===================================== @@ -265,7 +265,7 @@ IOWorkerProc(PVOID param) } // Free the WorkItem DeregisterWorkItem(iom,work); - free(work); + stgFree(work); } else { fprintf(stderr, "unable to fetch work; fatal.\n"); fflush(stderr); @@ -321,7 +321,7 @@ StartIOManager(void) wq = NewWorkQueue(); if ( !wq ) return false; - ioMan = (IOManagerState*)malloc(sizeof(IOManagerState)); + ioMan = (IOManagerState*)stgMallocBytes(sizeof(IOManagerState), "StartIOManager"); if (!ioMan) { FreeWorkQueue(wq); @@ -332,7 +332,7 @@ StartIOManager(void) hExit = CreateEvent ( NULL, true, false, NULL ); if ( !hExit ) { FreeWorkQueue(wq); - free(ioMan); + stgFree(ioMan); return false; } @@ -440,8 +440,7 @@ AddIORequest ( int fd, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return 0; + WorkItem* wItem = (WorkItem*)stgMallocBytse(sizeof(WorkItem), "AddIORequest"); unsigned int reqID = ioMan->requestID++; @@ -471,8 +470,7 @@ AddDelayRequest ( HsInt usecs, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return false; + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddDelayRequest"); unsigned int reqID = ioMan->requestID++; @@ -498,7 +496,7 @@ AddProcRequest ( void* proc, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddProcRequest"); if (!wItem) return false; unsigned int reqID = ioMan->requestID++; @@ -542,7 +540,7 @@ void ShutdownIOManager ( bool wait_threads ) barf("timeEndPeriod failed"); } - free(ioMan); + stgFree(ioMan); ioMan = NULL; } } ===================================== rts/win32/OSThreads.c ===================================== @@ -171,19 +171,19 @@ void freeThreadingResources (void) { if (cpuGroupCache) { - free(cpuGroupCache); + stgFree(cpuGroupCache); cpuGroupCache = NULL; } if (cpuGroupCumulativeCache) { - free(cpuGroupCumulativeCache); + stgFree(cpuGroupCumulativeCache); cpuGroupCumulativeCache = NULL; } if (cpuGroupDistCache) { - free(cpuGroupDistCache); + stgFree(cpuGroupDistCache); cpuGroupDistCache = NULL; } } @@ -240,7 +240,7 @@ getProcessorsDistribution (void) if (!cpuGroupDistCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupDistCache = malloc(n_groups * sizeof(uint8_t)); + cpuGroupDistCache = stgMallocBytes(n_groups * sizeof(uint8_t), "getProcessorsDistribution"); memset(cpuGroupDistCache, MAXIMUM_PROCESSORS, n_groups * sizeof(uint8_t)); for (int i = 0; i < n_groups; i++) @@ -265,7 +265,7 @@ getProcessorsCumulativeSum(void) if (!cpuGroupCumulativeCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupCumulativeCache = malloc(n_groups * sizeof(uint32_t)); + cpuGroupCumulativeCache = stgMallocBytes(n_groups * sizeof(uint32_t), "getProcessorsCumulativeSum"); memset(cpuGroupCumulativeCache, 0, n_groups * sizeof(uint32_t)); #if defined(x86_64_HOST_ARCH) @@ -306,7 +306,7 @@ createProcessorGroupMap (void) uint32_t numProcs = getNumberOfProcessors(); - cpuGroupCache = malloc(numProcs * sizeof(uint8_t)); + cpuGroupCache = stgMallocBytes(numProcs * sizeof(uint8_t), "createProcessorGroupMap"); /* For 32bit Windows and 64bit older than Windows 7, create a default mapping. */ memset(cpuGroupCache, 0, numProcs * sizeof(uint8_t)); @@ -386,7 +386,7 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M ASSERT(n_groups > 0); ASSERT(n_proc > 0); - mask = malloc(n_groups * sizeof(DWORD_PTR)); + mask = stgMallocBytes(n_groups * sizeof(DWORD_PTR), "setThreadAffinity"); memset(mask, 0, n_groups * sizeof(DWORD_PTR)); /* The mask for the individual groups are all 0 based @@ -422,14 +422,14 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M { r = SetThreadAffinityMask(hThread, mask[i]); if (r == 0) { - free(mask); + stgFree(mask); sysErrorBelch("SetThreadAffinity"); stg_exit(EXIT_FAILURE); } } } - free(mask); + stgFree(mask); } void ===================================== rts/win32/WorkQueue.c ===================================== @@ -41,12 +41,7 @@ newSemaphore(int initCount, int max) WorkQueue* NewWorkQueue() { - WorkQueue* wq = (WorkQueue*)malloc(sizeof(WorkQueue)); - - if (!wq) { - queue_error("NewWorkQueue", "malloc() failed"); - return wq; - } + WorkQueue* wq = (WorkQueue*)stgMallocBytes(sizeof(WorkQueue), "NewWorkQueue"); memset(wq, 0, sizeof *wq); ===================================== rts/xxhash.c ===================================== @@ -98,9 +98,9 @@ ***************************************/ /*! Modify the local functions below should you wish to use some other memory routines * for malloc(), free() */ -#include -static void* XXH_malloc(size_t s) { return malloc(s); } -static void XXH_free (void* p) { free(p); } +#include "Rts.h" +static void* XXH_malloc(size_t s) { return stgMallocBytes(s, "XXH_malloc"); } +static void XXH_free (void* p) { stgFree(p); } /*! and for memcpy() */ #include static void* XXH_memcpy(void* dest, const void* src, size_t size) { return memcpy(dest,src,size); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18e7310c99f68e86d9c727a1adfa48ee411191f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/18e7310c99f68e86d9c727a1adfa48ee411191f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 21:31:53 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 03 Sep 2020 17:31:53 -0400 Subject: [Git][ghc/ghc][master] configure: Work around Raspbian's silly packaging decisions Message-ID: <5f5160c93b218_80b3f8468cb176410467742@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 1 changed file: - aclocal.m4 Changes: ===================================== aclocal.m4 ===================================== @@ -447,25 +447,40 @@ AC_DEFUN([GET_ARM_ISA], #endif] )], [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7]) - ARM_ISA=ARMv6 - AC_COMPILE_IFELSE([ - AC_LANG_PROGRAM( - [], - [#if defined(__VFP_FP__) - return 0; - #else - no vfp - #endif] - )], - [changequote(, )dnl - ARM_ISA_EXT="[VFPv2]" - changequote([, ])dnl - ], - [changequote(, )dnl - ARM_ISA_EXT="[]" - changequote([, ])dnl - ] - )], + if grep -q Raspbian /etc/issue && uname -m | grep -q armv7; then + # Raspbian unfortunately makes some extremely questionable + # packaging decisions, configuring gcc to compile for ARMv6 + # despite the fact that the RPi4 is ARMv8. As ARMv8 doesn't + # support all instructions supported by ARMv6 this can + # break. Work around this by checking uname to verify + # that we aren't running on armv7. + # See #17856. + AC_MSG_NOTICE([Found compiler which claims to target ARMv6 running on ARMv7, assuming this is ARMv7 on Raspbian (see T17856)]) + ARM_ISA=ARMv7 + changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + else + ARM_ISA=ARMv6 + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM( + [], + [#if defined(__VFP_FP__) + return 0; + #else + no vfp + #endif] + )], + [changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + ], + [changequote(, )dnl + ARM_ISA_EXT="[]" + changequote([, ])dnl + ] + ) + fi], [changequote(, )dnl ARM_ISA=ARMv7 ARM_ISA_EXT="[VFPv3,NEON]" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/397c2b03e90e74c94ff55849adb6aa2a84e3e783 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/397c2b03e90e74c94ff55849adb6aa2a84e3e783 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 21:32:29 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 03 Sep 2020 17:32:29 -0400 Subject: [Git][ghc/ghc][master] expected-undocumented-flags remove kill flags Message-ID: <5f5160ed41042_80b3f840c265a8c10468164@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1 changed file: - docs/users_guide/expected-undocumented-flags.txt Changes: ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -101,8 +101,6 @@ -fimplicit-params -fimplicit-prelude -firrefutable-tuples --fkill-absence --fkill-one-shot -fmax-errors -fmax-pmcheck-iterations -fmono-pat-binds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4891c18a49876958b44e50dc6e2f24326d92052f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4891c18a49876958b44e50dc6e2f24326d92052f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 22:03:19 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 03 Sep 2020 18:03:19 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: configure: Work around Raspbian's silly packaging decisions Message-ID: <5f5168274a837_80bd9b13d010480586@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 589eeff2 by Sylvain Henry at 2020-09-03T18:03:11-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - e88fcb66 by Sylvain Henry at 2020-09-03T18:03:12-04:00 DynFlags: use Platform in foldRegs* - - - - - ba0f35f9 by Sylvain Henry at 2020-09-03T18:03:12-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - 04933454 by Ryan Scott at 2020-09-03T18:03:12-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 30 changed files: - aclocal.m4 - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Types/Id.hs - docs/users_guide/expected-undocumented-flags.txt - + testsuite/tests/ghci/scripts/T18644.script The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b86cf1a85c4069707753f1799b83269e26dbfe14...04933454bfd0d4f7b23c9cecc845877d0f716468 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b86cf1a85c4069707753f1799b83269e26dbfe14...04933454bfd0d4f7b23c9cecc845877d0f716468 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 22:28:28 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Sep 2020 18:28:28 -0400 Subject: [Git][ghc/ghc][wip/T18550] 80 commits: hadrian: depend on boot compiler version #18001 Message-ID: <5f516e0c563c5_80b3f849c1f975c1048305e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18550 at Glasgow Haskell Compiler / GHC Commits: a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - f1a71820 by GHC GitLab CI at 2020-09-03T18:26:59-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - d56b9fc1 by Ben Gamari at 2020-09-03T18:26:59-04:00 WIP - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Ppr/Decl.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0d79c84ba8ce032336d8f01a69a68684e90fb451...d56b9fc1845a13d5eb3703f247d1f1fb043b0fe7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/0d79c84ba8ce032336d8f01a69a68684e90fb451...d56b9fc1845a13d5eb3703f247d1f1fb043b0fe7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 3 23:55:45 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Sep 2020 19:55:45 -0400 Subject: [Git][ghc/ghc][wip/backports] configure: Avoid hard-coded ld path on Windows Message-ID: <5f51828197257_80b3f8496437e70104876e7@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 2dbdb7b9 by GHC GitLab CI at 2020-09-03T19:55:38-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). (cherry picked from commit 34e0fa963f35a77093fc7111a80c557fc6bd614f) - - - - - 7 changed files: - aclocal.m4 - compiler/GHC/Settings/IO.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - mk/config.mk.in - rules/build-package-way.mk Changes: ===================================== aclocal.m4 ===================================== @@ -516,6 +516,10 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="${mingw_bin_prefix}gcc.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="${mingw_bin_prefix}ld.exe" + # Overrides FIND_MERGE_OBJECTS in order to avoid hard-coding linker + # path on Windows (#18550). + SettingsMergeObjectsCommand="${SettingsLdCommand}" + SettingsMergeObjectsFlags="-r --oformat=pe-bigobj-x86-64" SettingsArCommand="${mingw_bin_prefix}ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}dllwrap.exe" @@ -529,6 +533,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" + SettingsMergeObjectsCommand="$(basename $MergeObjsCmd)" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$(basename $ArCmd)" SettingsDllWrapCommand="$(basename $DllWrapCmd)" SettingsWindresCommand="$(basename $WindresCmd)" @@ -538,6 +544,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$LdCmd" + SettingsMergeObjectsCommand="$MergeObjsCmd" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" if test -z "$DllWrapCmd" @@ -592,6 +600,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) AC_SUBST(SettingsLdFlags) + AC_SUBST(SettingsMergeObjectsCommand) + AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsDllWrapCommand) @@ -2605,7 +2615,7 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ ]) $CC -c -o conftest.a.o conftest.a.c || AC_MSG_ERROR([Failed to compile test]) - $SettingsMergeObjectsCommand $SettingsMergeObjectsFlags -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) + $MergeObjsCmd $MergeObjsArgs -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) $CC -c -o conftest.main.o conftest.main.c || AC_MSG_ERROR([Failed to compile test driver]) $CC conftest.ar.o conftest.main.o -o conftest || AC_MSG_ERROR([Failed to link test driver]) @@ -2625,33 +2635,30 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ # ------------------ # Find which linker to use to merge object files. # +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_REQUIRE([FIND_LD]) - if test -z "$SettingsMergeObjectsCommand"; then - SettingsMergeObjectsCommand="$LD" + if test -z "$MergeObjsCmd"; then + MergeObjsCmd="$LD" fi - if test -z "$SettingsMergeObjectsFlags"; then - SettingsMergeObjectsFlags="-r" + if test -z "$MergeObjsArgs"; then + MergeObjsArgs="-r" fi - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_NOTICE([$SettingsMergeObjectsCommand is broken due to binutils 22266, looking for another linker...]) - SettingsMergeObjectsCommand="" - AC_CHECK_TARGET_TOOL([SettingsMergeObjectsCommand], [ld]) - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + AC_MSG_NOTICE([$MergeObjsCmd is broken due to binutils 22266, looking for another linker...]) + MergeObjsCmd="" + AC_CHECK_TARGET_TOOL([MergeObjsCmd], [ld]) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the SettingsMergeObjectsCommand variable to a functional linker.]) + AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the MergeObjsCmd variable to a functional linker.]) fi fi - if test "$windows" = YES -a "$EnableDistroToolchain" = "NO" -a "$WORD_SIZE" = 64; then - SettingsMergeObjectsFlags="$SettingsMergeObjectsFlags --oformat=pe-bigobj-x86-64" - fi - - AC_SUBST(SettingsMergeObjectsCommand) - AC_SUBST(SettingsMergeObjectsFlags) + AC_SUBST([MergeObjsCmd]) + AC_SUBST([MergeObjsArgs]) ]) # FIND_PYTHON ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -138,7 +138,7 @@ initSettings top_dir = do as_args = map Option cc_args ld_prog = cc_prog ld_args = map Option (cc_args ++ words cc_link_args_str) - ld_r_prog <- getSetting "Merge objects command" + ld_r_prog <- getToolSetting "Merge objects command" ld_r_args <- getSetting "Merge objects flags" llvmTarget <- getSetting "LLVM target" ===================================== configure.ac ===================================== @@ -448,6 +448,8 @@ then NM="${mingwbin}nm.exe" RANLIB="${mingwbin}ranlib.exe" OBJDUMP="${mingwbin}objdump.exe" + MergeObjsCmd="$LD" + MergeObjsArgs="-r --oformat=pe-bigobj-x86-64" fp_prog_ar="${mingwbin}ar.exe" AC_PATH_PROG([Genlib],[genlib]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -14,6 +14,7 @@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ nm = @NmCmd@ +merge-objects = @MergeObjsCmd@ objdump = @ObjdumpCmd@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ @@ -115,10 +116,10 @@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ -conf-merge-objects-args-stage0 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage1 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage2 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage3 = @SettingsMergeObjectsFlags@ +conf-merge-objects-args-stage0 = @MergeObjsArgs@ +conf-merge-objects-args-stage1 = @MergeObjsArgs@ +conf-merge-objects-args-stage2 = @MergeObjsArgs@ +conf-merge-objects-args-stage3 = @MergeObjsArgs@ # Settings: ===================================== hadrian/src/Builder.hs ===================================== @@ -312,7 +312,7 @@ systemBuilderPath builder = case builder of Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" Ld _ -> fromKey "ld" - MergeObjects _ -> fromKey "settings-merge-objects-command" + MergeObjects _ -> fromKey "merge-objects" Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" Nm -> fromKey "nm" ===================================== mk/config.mk.in ===================================== @@ -544,6 +544,16 @@ LD_STAGE1 = $(LD) LD_STAGE2 = $(LD) LD_STAGE3 = $(LD) +MERGE_OBJS_STAGE0 = @MergeObjsCmd@ +MERGE_OBJS_STAGE1 = @MergeObjsCmd@ +MERGE_OBJS_STAGE2 = @MergeObjsCmd@ +MERGE_OBJS_STAGE3 = @MergeObjsCmd@ + +MERGE_OBJS_STAGE0_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE1_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE2_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE3_FLAGS = @MergeObjsArgs@ + # Cross-compiling options # See Note [CrossCompiling vs Stage1Only] CrossCompiling = @CrossCompiling@ ===================================== rules/build-package-way.mk ===================================== @@ -107,6 +107,7 @@ endif endif # Build the GHCi library +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. ifneq "$(filter $3, v p)" "" $1_$2_$3_GHCI_LIB = $1/$2/build/HS$$($1_$2_COMPONENT_ID).$$($3_osuf) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" @@ -116,7 +117,7 @@ BINDIST_LIBS += $$($1_$2_$3_GHCI_LIB) endif endif $$($1_$2_$3_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) $$($1_$2_LD_SCRIPT) - $$(call cmd,SettingsMergeObjectsCommand) $(SettingsMergeObjectsFlags) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) + $$(call cmd,MERGE_OBJS_STAGE$4) $(MERGE_OBJS_STAGE$4_FLAGS) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" # Don't bother making ghci libs for bootstrapping packages ifneq "$4" "0" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2dbdb7b9f3c4f10566072f18d7b5f11a9d330211 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2dbdb7b9f3c4f10566072f18d7b5f11a9d330211 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 01:24:49 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Sep 2020 21:24:49 -0400 Subject: [Git][ghc/ghc][wip/T18550] 8 commits: testsuite: Add broken test for #18302 Message-ID: <5f519761b09e7_80bb3e4fbc1049468a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18550 at Glasgow Haskell Compiler / GHC Commits: b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 34e0fa96 by GHC GitLab CI at 2020-09-03T19:55:29-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 21 changed files: - aclocal.m4 - compiler/GHC/Builtin/Names.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/expected-undocumented-flags.txt - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - libraries/base/Data/OldList.hs - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs - mk/config.mk.in - rules/build-package-way.mk - + testsuite/tests/rename/should_compile/T18302A.hs - + testsuite/tests/rename/should_compile/T18302B.hs - testsuite/tests/rename/should_compile/all.T Changes: ===================================== aclocal.m4 ===================================== @@ -447,25 +447,40 @@ AC_DEFUN([GET_ARM_ISA], #endif] )], [AC_DEFINE(arm_HOST_ARCH_PRE_ARMv7, 1, [ARM pre v7]) - ARM_ISA=ARMv6 - AC_COMPILE_IFELSE([ - AC_LANG_PROGRAM( - [], - [#if defined(__VFP_FP__) - return 0; - #else - no vfp - #endif] - )], - [changequote(, )dnl - ARM_ISA_EXT="[VFPv2]" - changequote([, ])dnl - ], - [changequote(, )dnl - ARM_ISA_EXT="[]" - changequote([, ])dnl - ] - )], + if grep -q Raspbian /etc/issue && uname -m | grep -q armv7; then + # Raspbian unfortunately makes some extremely questionable + # packaging decisions, configuring gcc to compile for ARMv6 + # despite the fact that the RPi4 is ARMv8. As ARMv8 doesn't + # support all instructions supported by ARMv6 this can + # break. Work around this by checking uname to verify + # that we aren't running on armv7. + # See #17856. + AC_MSG_NOTICE([Found compiler which claims to target ARMv6 running on ARMv7, assuming this is ARMv7 on Raspbian (see T17856)]) + ARM_ISA=ARMv7 + changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + else + ARM_ISA=ARMv6 + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM( + [], + [#if defined(__VFP_FP__) + return 0; + #else + no vfp + #endif] + )], + [changequote(, )dnl + ARM_ISA_EXT="[VFPv2]" + changequote([, ])dnl + ], + [changequote(, )dnl + ARM_ISA_EXT="[]" + changequote([, ])dnl + ] + ) + fi], [changequote(, )dnl ARM_ISA=ARMv7 ARM_ISA_EXT="[VFPv3,NEON]" @@ -517,6 +532,10 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="${mingw_bin_prefix}gcc.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="${mingw_bin_prefix}ld.exe" + # Overrides FIND_MERGE_OBJECTS in order to avoid hard-coding linker + # path on Windows (#18550). + SettingsMergeObjectsCommand="${SettingsLdCommand}" + SettingsMergeObjectsFlags="-r --oformat=pe-bigobj-x86-64" SettingsArCommand="${mingw_bin_prefix}ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}dllwrap.exe" @@ -530,6 +549,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" + SettingsMergeObjectsCommand="$(basename $MergeObjsCmd)" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$(basename $ArCmd)" SettingsDllWrapCommand="$(basename $DllWrapCmd)" SettingsWindresCommand="$(basename $WindresCmd)" @@ -539,6 +560,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$LdCmd" + SettingsMergeObjectsCommand="$MergeObjsCmd" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" if test -z "$DllWrapCmd" @@ -594,6 +617,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) AC_SUBST(SettingsLdFlags) + AC_SUBST(SettingsMergeObjectsCommand) + AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsDllWrapCommand) @@ -2610,7 +2635,7 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ ]) $CC -c -o conftest.a.o conftest.a.c || AC_MSG_ERROR([Failed to compile test]) - $SettingsMergeObjectsCommand $SettingsMergeObjectsFlags -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) + $MergeObjsCmd $MergeObjsArgs -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) $CC -c -o conftest.main.o conftest.main.c || AC_MSG_ERROR([Failed to compile test driver]) $CC conftest.ar.o conftest.main.o -o conftest || AC_MSG_ERROR([Failed to link test driver]) @@ -2630,33 +2655,30 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ # ------------------ # Find which linker to use to merge object files. # +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_REQUIRE([FIND_LD]) - if test -z "$SettingsMergeObjectsCommand"; then - SettingsMergeObjectsCommand="$LD" + if test -z "$MergeObjsCmd"; then + MergeObjsCmd="$LD" fi - if test -z "$SettingsMergeObjectsFlags"; then - SettingsMergeObjectsFlags="-r" + if test -z "$MergeObjsArgs"; then + MergeObjsArgs="-r" fi - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_NOTICE([$SettingsMergeObjectsCommand is broken due to binutils 22266, looking for another linker...]) - SettingsMergeObjectsCommand="" - AC_CHECK_TARGET_TOOL([SettingsMergeObjectsCommand], [ld]) - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + AC_MSG_NOTICE([$MergeObjsCmd is broken due to binutils 22266, looking for another linker...]) + MergeObjsCmd="" + AC_CHECK_TARGET_TOOL([MergeObjsCmd], [ld]) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the SettingsMergeObjectsCommand variable to a functional linker.]) + AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the MergeObjsCmd variable to a functional linker.]) fi fi - if test "$windows" = YES -a "$EnableDistroToolchain" = "NO" -a "$WORD_SIZE" = 64; then - SettingsMergeObjectsFlags="$SettingsMergeObjectsFlags --oformat=pe-bigobj-x86-64" - fi - - AC_SUBST(SettingsMergeObjectsCommand) - AC_SUBST(SettingsMergeObjectsFlags) + AC_SUBST([MergeObjsCmd]) + AC_SUBST([MergeObjsArgs]) ]) # FIND_PYTHON ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -116,35 +116,6 @@ known keys. See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys) in GHC.Builtin.Types. -Note [The integer library] -~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Clearly, we need to know the names of various definitions of the integer -library, e.g. the type itself, `mkInteger` etc. But there are two possible -implementations of the integer library: - - * integer-gmp (fast, but uses libgmp, which may not be available on all - targets and is GPL licensed) - * integer-simple (slow, but pure Haskell and BSD-licensed) - -We want the compiler to work with either one. The way we achieve this is: - - * When compiling the integer-{gmp,simple} library, we pass - -this-unit-id integer-wired-in - to GHC (see the cabal file libraries/integer-{gmp,simple}. - * This way, GHC can use just this UnitID (see Module.integerUnitId) when - generating code, and the linker will succeed. - -Unfortuately, the abstraction is not complete: When using integer-gmp, we -really want to use the S# constructor directly. This is controlled by -the `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use -this constructor directly (see CorePrep.lookupIntegerSDataConName) - -When GHC reads the package data base, it (internally only) pretends it has UnitId -`integer-wired-in` instead of the actual UnitId (which includes the version -number); just like for `base` and other packages, as described in -Note [Wired-in units] in GHC.Unit.Module. This is done in -GHC.Unit.State.findWiredInUnits. -} {-# LANGUAGE CPP #-} ===================================== compiler/GHC/CmmToAsm/Reg/Linear.hs ===================================== @@ -205,7 +205,7 @@ regAlloc _ (CmmProc _ _ _ _) -- an entry in the block map or it is the first block. -- linearRegAlloc - :: Instruction instr + :: forall instr. Instruction instr => NCGConfig -> [BlockId] -- ^ entry points -> BlockMap RegSet @@ -231,6 +231,8 @@ linearRegAlloc config entry_ids block_live sccs ArchJavaScript -> panic "linearRegAlloc ArchJavaScript" ArchUnknown -> panic "linearRegAlloc ArchUnknown" where + go :: (FR regs, Outputable regs) + => regs -> UniqSM ([NatBasicBlock instr], RegAllocStats, Int) go f = linearRegAlloc' config f entry_ids block_live sccs platform = ncgPlatform config @@ -973,4 +975,3 @@ loadTemp vreg (ReadMem slot) hreg spills loadTemp _ _ _ spills = return spills - ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -2290,6 +2290,7 @@ lintCoercion this@(AxiomRuleCo ax cos) Nothing -> err "Malformed use of AxiomRuleCo" [ ppr this ] Just _ -> return (AxiomRuleCo ax cos') } where + err :: forall a. String -> [SDoc] -> LintM a err m xs = failWithL $ hang (text m) 2 $ vcat (text "Rule:" <+> ppr (coaxrName ax) : xs) ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -1909,7 +1909,7 @@ completeCall env var cont log_inlining $ sep [text "Inlining done:", nest 4 (ppr var)] | otherwise - = liftIO $ log_inlining $ + = log_inlining $ sep [text "Inlining done: " <> ppr var, nest 4 (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding), text "Cont: " <+> ppr cont])] ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -1373,7 +1373,8 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup -- -- There better had not be any cyclic groups here -- we check for them. upsweep - :: GhcMonad m + :: forall m + . GhcMonad m => Maybe Messager -> HomePackageTable -- ^ HPT from last time round (pruned) -> StableModules -- ^ stable modules (see checkStability) @@ -1415,8 +1416,7 @@ upsweep mHscMessage old_hpt stable_mods cleanup sccs = do return (Failed, done') upsweep' - :: GhcMonad m - => HomePackageTable + :: HomePackageTable -> ModuleGraph -> [SCC ModSummary] -> Int ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -1134,6 +1134,7 @@ unload_wkr hsc_env keep_linkables pls at PersistentLinkerState{..} = do -- Note that we want to remove all *local* -- (i.e. non-isExternal) names too (these are the -- temporary bindings from the command line). + keep_name :: (Name, a) -> Bool keep_name (n,_) = isExternalName n && nameModule n `elemModuleSet` bcos_retained ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -137,7 +137,7 @@ initSettings top_dir = do as_args = map Option cc_args ld_prog = cc_prog ld_args = map Option (cc_args ++ words cc_link_args_str) - ld_r_prog <- getSetting "Merge objects command" + ld_r_prog <- getToolSetting "Merge objects command" ld_r_args <- getSetting "Merge objects flags" llvmTarget <- getSetting "LLVM target" ===================================== compiler/GHC/SysTools.hs ===================================== @@ -138,15 +138,17 @@ lazyInitLlvmConfig :: String -> IO LlvmConfig lazyInitLlvmConfig top_dir = unsafeInterleaveIO $ do -- see Note [LLVM configuration] - targets <- readAndParse "llvm-targets" mkLlvmTarget - passes <- readAndParse "llvm-passes" id - return $ LlvmConfig { llvmTargets = targets, llvmPasses = passes } + targets <- readAndParse "llvm-targets" + passes <- readAndParse "llvm-passes" + return $ LlvmConfig { llvmTargets = fmap mkLlvmTarget <$> targets, + llvmPasses = passes } where - readAndParse name builder = + readAndParse :: Read a => String -> IO a + readAndParse name = do let llvmConfigFile = top_dir name llvmConfigStr <- readFile llvmConfigFile case maybeReadFuzzy llvmConfigStr of - Just s -> return (fmap builder <$> s) + Just s -> return s Nothing -> pgmError ("Can't parse " ++ show llvmConfigFile) mkLlvmTarget :: (String, String, String) -> LlvmTarget ===================================== compiler/ghc.cabal.in ===================================== @@ -153,6 +153,7 @@ Library NoImplicitPrelude ,BangPatterns ,ScopedTypeVariables + ,MonoLocalBinds Exposed-Modules: GHC.Iface.Ext.Types ===================================== configure.ac ===================================== @@ -449,6 +449,8 @@ then NM="${mingwbin}nm.exe" RANLIB="${mingwbin}ranlib.exe" OBJDUMP="${mingwbin}objdump.exe" + MergeObjsCmd="$LD" + MergeObjsArgs="-r --oformat=pe-bigobj-x86-64" fp_prog_ar="${mingwbin}ar.exe" AC_PATH_PROG([Genlib],[genlib]) ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -101,8 +101,6 @@ -fimplicit-params -fimplicit-prelude -firrefutable-tuples --fkill-absence --fkill-one-shot -fmax-errors -fmax-pmcheck-iterations -fmono-pat-binds ===================================== hadrian/cfg/system.config.in ===================================== @@ -14,6 +14,7 @@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ nm = @NmCmd@ +merge-objects = @MergeObjsCmd@ objdump = @ObjdumpCmd@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ @@ -117,10 +118,10 @@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ -conf-merge-objects-args-stage0 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage1 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage2 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage3 = @SettingsMergeObjectsFlags@ +conf-merge-objects-args-stage0 = @MergeObjsArgs@ +conf-merge-objects-args-stage1 = @MergeObjsArgs@ +conf-merge-objects-args-stage2 = @MergeObjsArgs@ +conf-merge-objects-args-stage3 = @MergeObjsArgs@ # Settings: ===================================== hadrian/src/Builder.hs ===================================== @@ -317,7 +317,7 @@ systemBuilderPath builder = case builder of Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" Ld _ -> fromKey "ld" - MergeObjects _ -> fromKey "settings-merge-objects-command" + MergeObjects _ -> fromKey "merge-objects" Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" Nm -> fromKey "nm" ===================================== libraries/base/Data/OldList.hs ===================================== @@ -550,7 +550,13 @@ intercalate xs xss = concat (intersperse xs xss) transpose :: [[a]] -> [[a]] transpose [] = [] transpose ([] : xss) = transpose xss -transpose ((x:xs) : xss) = (x : [h | (h:_) <- xss]) : transpose (xs : [ t | (_:t) <- xss]) +transpose ((x:xs) : xss) = (x : hds) : transpose (xs : tls) + where + -- We tie the calculations of heads and tails together + -- to prevent heads from leaking into tails and vice versa. + -- unzip makes the selector thunk arrangements we need to + -- ensure everything gets cleaned up properly. + (hds, tls) = unzip [(hd, tl) | (hd:tl) <- xss] -- | The 'partition' function takes a predicate a list and returns ===================================== libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs ===================================== @@ -57,9 +57,6 @@ module GHC.Integer.GMP.Internals , bigNatToInt , bigNatToWord , indexBigNat# - , importBigNatFromByteArray - , exportBigNatToMutableByteArray - -- ** 'BigNat' arithmetic operations , plusBigNat @@ -112,9 +109,17 @@ module GHC.Integer.GMP.Internals -- ** Export , exportBigNatToAddr + , exportIntegerToAddr + + , exportBigNatToMutableByteArray + , exportIntegerToMutableByteArray -- ** Import , importBigNatFromAddr + , importIntegerFromAddr + + , importBigNatFromByteArray + , importIntegerFromByteArray ) where import GHC.Integer @@ -373,6 +378,18 @@ exportBigNatToAddr (BN# b) addr endian = IO \s -> case B.bigNatToAddr# b addr endian s of (# s', w #) -> (# s', W# w #) +{-# DEPRECATED importIntegerFromAddr "Use integerFromAddr# instead" #-} +importIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer +importIntegerFromAddr addr sz endian = IO \s -> + case I.integerFromAddr# sz addr endian s of + (# s', i #) -> (# s', i #) + +{-# DEPRECATED exportIntegerToAddr "Use integerToAddr# instead" #-} +exportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word +exportIntegerToAddr i addr endian = IO \s -> + case I.integerToAddr# i addr endian s of + (# s', w #) -> (# s', W# w #) + wordToBigNat :: Word# -> BigNat wordToBigNat w = BN# (B.bigNatFromWord# w) @@ -398,3 +415,13 @@ importBigNatFromByteArray ba off sz endian = case runRW# (B.bigNatFromByteArray# exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word exportBigNatToMutableByteArray (BN# ba) mba off endian = IO (\s -> case B.bigNatToMutableByteArray# ba mba off endian s of (# s', r #) -> (# s', W# r #)) + +{-# DEPRECATED importIntegerFromByteArray "Use integerFromByteArray# instead" #-} +importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer +importIntegerFromByteArray ba off sz endian = case runRW# (I.integerFromByteArray# sz ba off endian) of + (# _, r #) -> r + +{-# DEPRECATED exportIntegerToMutableByteArray "Use integerToMutableByteArray# instead" #-} +exportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word +exportIntegerToMutableByteArray i mba off endian = IO (\s -> case I.integerToMutableByteArray# i mba off endian s of + (# s', r #) -> (# s', W# r #)) ===================================== mk/config.mk.in ===================================== @@ -545,6 +545,16 @@ LD_STAGE1 = $(LD) LD_STAGE2 = $(LD) LD_STAGE3 = $(LD) +MERGE_OBJS_STAGE0 = @MergeObjsCmd@ +MERGE_OBJS_STAGE1 = @MergeObjsCmd@ +MERGE_OBJS_STAGE2 = @MergeObjsCmd@ +MERGE_OBJS_STAGE3 = @MergeObjsCmd@ + +MERGE_OBJS_STAGE0_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE1_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE2_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE3_FLAGS = @MergeObjsArgs@ + # Cross-compiling options # See Note [CrossCompiling vs Stage1Only] CrossCompiling = @CrossCompiling@ ===================================== rules/build-package-way.mk ===================================== @@ -107,6 +107,7 @@ endif endif # Build the GHCi library +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. ifneq "$(filter $3, v p)" "" $1_$2_$3_GHCI_LIB = $1/$2/build/HS$$($1_$2_COMPONENT_ID).$$($3_osuf) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" @@ -116,7 +117,7 @@ BINDIST_LIBS += $$($1_$2_$3_GHCI_LIB) endif endif $$($1_$2_$3_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) $$($1_$2_LD_SCRIPT) - $$(call cmd,SettingsMergeObjectsCommand) $(SettingsMergeObjectsFlags) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) + $$(call cmd,MERGE_OBJS_STAGE$4) $(MERGE_OBJS_STAGE$4_FLAGS) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" # Don't bother making ghci libs for bootstrapping packages ifneq "$4" "0" ===================================== testsuite/tests/rename/should_compile/T18302A.hs ===================================== @@ -0,0 +1,4 @@ +module T18302A ( module GHC.Prim ) where + +import GHC.Prim + ===================================== testsuite/tests/rename/should_compile/T18302B.hs ===================================== @@ -0,0 +1,8 @@ +-- | Check that TYPE and (->) are re-exportable. +module T18302B where + +import T18302A + +type T = TYPE +type F = (->) + ===================================== testsuite/tests/rename/should_compile/all.T ===================================== @@ -176,3 +176,4 @@ test('T17832', [], multimod_compile, ['T17832M1', 'T17832M2']) test('T17837', normal, compile, ['']) test('T18497', [], makefile_test, ['T18497']) test('T18264', [], makefile_test, ['T18264']) +test('T18302', expect_broken(18302), compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d56b9fc1845a13d5eb3703f247d1f1fb043b0fe7...34e0fa963f35a77093fc7111a80c557fc6bd614f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d56b9fc1845a13d5eb3703f247d1f1fb043b0fe7...34e0fa963f35a77093fc7111a80c557fc6bd614f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 01:32:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Sep 2020 21:32:09 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/bump-ci-images Message-ID: <5f51991940ee7_80bd5b029010495815@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/bump-ci-images You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 02:45:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 03 Sep 2020 22:45:14 -0400 Subject: [Git][ghc/ghc][wip/stgMalloc] 55 commits: Put CFG weights into their own module (#17957) Message-ID: <5f51aa3a5c326_80b79951b81049809c@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/stgMalloc at Glasgow Haskell Compiler / GHC Commits: 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 20d4404d by GHC GitLab CI at 2020-09-03T22:45:03-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/linters/check-cpp.py - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/CFG.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - + compiler/GHC/CmmToAsm/CFG/Weight.hs - compiler/GHC/CmmToAsm/Config.hs - compiler/GHC/CmmToAsm/Dwarf.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph/Base.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18e7310c99f68e86d9c727a1adfa48ee411191f0...20d4404d6e72b2d25cd5077f05a9553fa7db018e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/18e7310c99f68e86d9c727a1adfa48ee411191f0...20d4404d6e72b2d25cd5077f05a9553fa7db018e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 03:33:40 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 03 Sep 2020 23:33:40 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Don't rely on CLabel's Outputable instance in CmmToC Message-ID: <5f51b59447569_80b3f848618e5d010504052@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 25b4604a by Sylvain Henry at 2020-09-03T23:33:28-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - d8ee2429 by Sylvain Henry at 2020-09-03T23:33:30-04:00 DynFlags: use Platform in foldRegs* - - - - - ff888421 by Sylvain Henry at 2020-09-03T23:33:30-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - ff8a6dea by Ryan Scott at 2020-09-03T23:33:30-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Types/Id.hs - + testsuite/tests/ghci/scripts/T18644.script - + testsuite/tests/ghci/scripts/T18644.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -108,7 +108,7 @@ module GHC.Cmm.CLabel ( -- * Conversions toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName, - pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, + pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, pprCLabel_ViaC, isInfoTableLabel, isConInfoTableLabel, isIdLabel, isTickyLabel @@ -1218,11 +1218,15 @@ pprCLabel bcknd platform lbl = case bcknd of NCG -> pprCLabel_NCG platform lbl LLVM -> pprCLabel_LLVM platform lbl + ViaC -> pprCLabel_ViaC platform lbl _ -> pprCLabel_other platform lbl pprCLabel_LLVM :: Platform -> CLabel -> SDoc pprCLabel_LLVM = pprCLabel_NCG +pprCLabel_ViaC :: Platform -> CLabel -> SDoc +pprCLabel_ViaC = pprCLabel_other + pprCLabel_NCG :: Platform -> CLabel -> SDoc pprCLabel_NCG platform lbl = getPprStyle $ \sty -> let @@ -1348,7 +1352,13 @@ pprCLabel_common platform = \case (ForeignLabel str _ _ _) -> ftext str - (IdLabel name _cafs flavor) -> internalNamePrefix platform name <> ppr name <> ppIdFlavor flavor + (IdLabel name _cafs flavor) -> internalNamePrefix <> ppr name <> ppIdFlavor flavor + where + isRandomGenerated = not (isExternalName name) + internalNamePrefix = getPprStyle $ \ sty -> + if asmStyle sty && isRandomGenerated + then ptext (asmTempLabelPrefix platform) + else empty (CC_Label cc) -> ppr cc (CCS_Label ccs) -> ppr ccs @@ -1389,15 +1399,6 @@ instance Outputable ForeignLabelSource where ForeignLabelInThisPackage -> parens $ text "this package" ForeignLabelInExternalPackage -> parens $ text "external package" -internalNamePrefix :: Platform -> Name -> SDoc -internalNamePrefix platform name = getPprStyle $ \ sty -> - if asmStyle sty && isRandomGenerated then - ptext (asmTempLabelPrefix platform) - else - empty - where - isRandomGenerated = not $ isExternalName name - tempLabelPrefixOrUnderscore :: Platform -> SDoc tempLabelPrefixOrUnderscore platform = getPprStyle $ \ sty -> ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -38,7 +38,6 @@ import GHC.Cmm.BlockId import GHC.Cmm.CLabel import GHC.Cmm.MachOp import GHC.Cmm.Type -import GHC.Driver.Session import GHC.Utils.Panic (panic) import GHC.Types.Unique @@ -331,17 +330,17 @@ sizeRegSet = Set.size regSetToList = Set.toList class Ord r => UserOfRegs r a where - foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b + foldRegsUsed :: Platform -> (b -> r -> b) -> b -> a -> b foldLocalRegsUsed :: UserOfRegs LocalReg a - => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b + => Platform -> (b -> LocalReg -> b) -> b -> a -> b foldLocalRegsUsed = foldRegsUsed class Ord r => DefinerOfRegs r a where - foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b + foldRegsDefd :: Platform -> (b -> r -> b) -> b -> a -> b foldLocalRegsDefd :: DefinerOfRegs LocalReg a - => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b + => Platform -> (b -> LocalReg -> b) -> b -> a -> b foldLocalRegsDefd = foldRegsDefd instance UserOfRegs LocalReg CmmReg where @@ -369,20 +368,20 @@ instance Ord r => DefinerOfRegs r r where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance - foldRegsUsed dflags f !z e = expr z e + foldRegsUsed platform f !z e = expr z e where expr z (CmmLit _) = z - expr z (CmmLoad addr _) = foldRegsUsed dflags f z addr - expr z (CmmReg r) = foldRegsUsed dflags f z r - expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs - expr z (CmmRegOff r _) = foldRegsUsed dflags f z r + expr z (CmmLoad addr _) = foldRegsUsed platform f z addr + expr z (CmmReg r) = foldRegsUsed platform f z r + expr z (CmmMachOp _ exprs) = foldRegsUsed platform f z exprs + expr z (CmmRegOff r _) = foldRegsUsed platform f z r expr z (CmmStackSlot _ _) = z instance UserOfRegs r a => UserOfRegs r [a] where - foldRegsUsed dflags f set as = foldl' (foldRegsUsed dflags f) set as + foldRegsUsed platform f set as = foldl' (foldRegsUsed platform f) set as {-# INLINABLE foldRegsUsed #-} instance DefinerOfRegs r a => DefinerOfRegs r [a] where - foldRegsDefd dflags f set as = foldl' (foldRegsDefd dflags f) set as + foldRegsDefd platform f set as = foldl' (foldRegsDefd platform f) set as {-# INLINABLE foldRegsDefd #-} ----------------------------------------------------------------------------- ===================================== compiler/GHC/Cmm/LayoutStack.hs ===================================== @@ -246,9 +246,10 @@ cmmLayoutStack dflags procpoints entry_args = do -- We need liveness info. Dead assignments are removed later -- by the sinking pass. - let liveness = cmmLocalLiveness dflags graph + let liveness = cmmLocalLiveness platform graph blocks = revPostorder graph - profile = targetProfile dflags + profile = targetProfile dflags + platform = profilePlatform profile (final_stackmaps, _final_high_sp, new_blocks) <- mfix $ \ ~(rec_stackmaps, rec_high_sp, _new_blocks) -> @@ -256,7 +257,7 @@ cmmLayoutStack dflags procpoints entry_args rec_stackmaps rec_high_sp blocks blocks_with_reloads <- - insertReloadsAsNeeded dflags procpoints final_stackmaps entry new_blocks + insertReloadsAsNeeded platform procpoints final_stackmaps entry new_blocks new_blocks' <- mapM (lowerSafeForeignCall profile) blocks_with_reloads return (ofBlockList entry new_blocks', final_stackmaps) @@ -1044,30 +1045,29 @@ stackMapToLiveness platform StackMap{..} = -- ----------------------------------------------------------------------------- insertReloadsAsNeeded - :: DynFlags + :: Platform -> ProcPointSet -> LabelMap StackMap -> BlockId -> [CmmBlock] -> UniqSM [CmmBlock] -insertReloadsAsNeeded dflags procpoints final_stackmaps entry blocks = do +insertReloadsAsNeeded platform procpoints final_stackmaps entry blocks = do toBlockList . fst <$> rewriteCmmBwd liveLattice rewriteCC (ofBlockList entry blocks) mapEmpty where rewriteCC :: RewriteFun CmmLocalLive rewriteCC (BlockCC e_node middle0 x_node) fact_base0 = do let entry_label = entryLabel e_node - platform = targetPlatform dflags stackmap = case mapLookup entry_label final_stackmaps of Just sm -> sm Nothing -> panic "insertReloadsAsNeeded: rewriteCC: stackmap" -- Merge the liveness from successor blocks and analyse the last -- node. - joined = gen_kill dflags x_node $! + joined = gen_kill platform x_node $! joinOutFacts liveLattice x_node fact_base0 -- What is live at the start of middle0. - live_at_middle0 = foldNodesBwdOO (gen_kill dflags) middle0 joined + live_at_middle0 = foldNodesBwdOO (gen_kill platform) middle0 joined -- If this is a procpoint we need to add the reloads, but only if -- they're actually live. Furthermore, nothing is live at the entry ===================================== compiler/GHC/Cmm/Lint.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Cmm.Liveness import GHC.Cmm.Switch (switchTargetsToList) import GHC.Cmm.Ppr () -- For Outputable instances import GHC.Utils.Outputable -import GHC.Driver.Session import Control.Monad (ap, unless) @@ -39,37 +38,38 @@ import Control.Monad (ap, unless) -- Exported entry points: cmmLint :: (Outputable d, Outputable h) - => DynFlags -> GenCmmGroup d h CmmGraph -> Maybe SDoc -cmmLint dflags tops = runCmmLint dflags (mapM_ (lintCmmDecl dflags)) tops + => Platform -> GenCmmGroup d h CmmGraph -> Maybe SDoc +cmmLint platform tops = runCmmLint platform (mapM_ lintCmmDecl) tops -cmmLintGraph :: DynFlags -> CmmGraph -> Maybe SDoc -cmmLintGraph dflags g = runCmmLint dflags (lintCmmGraph dflags) g +cmmLintGraph :: Platform -> CmmGraph -> Maybe SDoc +cmmLintGraph platform g = runCmmLint platform lintCmmGraph g -runCmmLint :: Outputable a => DynFlags -> (a -> CmmLint b) -> a -> Maybe SDoc -runCmmLint dflags l p = - case unCL (l p) dflags of +runCmmLint :: Outputable a => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc +runCmmLint platform l p = + case unCL (l p) platform of Left err -> Just (vcat [text "Cmm lint error:", nest 2 err, text "Program was:", nest 2 (ppr p)]) Right _ -> Nothing -lintCmmDecl :: DynFlags -> GenCmmDecl h i CmmGraph -> CmmLint () -lintCmmDecl dflags (CmmProc _ lbl _ g) - = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph dflags g -lintCmmDecl _ (CmmData {}) +lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint () +lintCmmDecl (CmmProc _ lbl _ g) + = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph g +lintCmmDecl (CmmData {}) = return () -lintCmmGraph :: DynFlags -> CmmGraph -> CmmLint () -lintCmmGraph dflags g = - cmmLocalLiveness dflags g `seq` mapM_ (lintCmmBlock labels) blocks - -- cmmLiveness throws an error if there are registers - -- live on entry to the graph (i.e. undefined - -- variables) - where - blocks = toBlockList g - labels = setFromList (map entryLabel blocks) +lintCmmGraph :: CmmGraph -> CmmLint () +lintCmmGraph g = do + platform <- getPlatform + let + blocks = toBlockList g + labels = setFromList (map entryLabel blocks) + cmmLocalLiveness platform g `seq` mapM_ (lintCmmBlock labels) blocks + -- cmmLiveness throws an error if there are registers + -- live on entry to the graph (i.e. undefined + -- variables) lintCmmBlock :: LabelSet -> CmmBlock -> CmmLint () @@ -225,9 +225,9 @@ lintTarget (PrimTarget {}) = return () mayNotMentionCallerSavedRegs :: (UserOfRegs GlobalReg a, Outputable a) => SDoc -> a -> CmmLint () mayNotMentionCallerSavedRegs what thing = do - dflags <- getDynFlags - let badRegs = filter (callerSaves (targetPlatform dflags)) - $ foldRegsUsed dflags (flip (:)) [] thing + platform <- getPlatform + let badRegs = filter (callerSaves platform) + $ foldRegsUsed platform (flip (:)) [] thing unless (null badRegs) $ cmmLintErr (what <+> text "mentions caller-saved registers: " <> ppr badRegs $$ ppr thing) @@ -243,7 +243,7 @@ checkCond _ expr -- just a basic error monad: -newtype CmmLint a = CmmLint { unCL :: DynFlags -> Either SDoc a } +newtype CmmLint a = CmmLint { unCL :: Platform -> Either SDoc a } deriving (Functor) instance Applicative CmmLint where @@ -251,23 +251,20 @@ instance Applicative CmmLint where (<*>) = ap instance Monad CmmLint where - CmmLint m >>= k = CmmLint $ \dflags -> - case m dflags of + CmmLint m >>= k = CmmLint $ \platform -> + case m platform of Left e -> Left e - Right a -> unCL (k a) dflags - -instance HasDynFlags CmmLint where - getDynFlags = CmmLint (\dflags -> Right dflags) + Right a -> unCL (k a) platform getPlatform :: CmmLint Platform -getPlatform = targetPlatform <$> getDynFlags +getPlatform = CmmLint $ \platform -> Right platform cmmLintErr :: SDoc -> CmmLint a cmmLintErr msg = CmmLint (\_ -> Left msg) addLintInfo :: SDoc -> CmmLint a -> CmmLint a -addLintInfo info thing = CmmLint $ \dflags -> - case unCL thing dflags of +addLintInfo info thing = CmmLint $ \platform -> + case unCL thing platform of Left err -> Left (hang info 2 err) Right a -> Right a ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -14,7 +14,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Platform import GHC.Cmm.BlockId import GHC.Cmm import GHC.Cmm.Ppr.Expr () -- For Outputable instances @@ -52,17 +52,17 @@ type BlockEntryLiveness r = LabelMap (CmmLive r) -- | Calculated liveness info for a CmmGraph ----------------------------------------------------------------------------- -cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg -cmmLocalLiveness dflags graph = - check $ analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty +cmmLocalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg +cmmLocalLiveness platform graph = + check $ analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty where entry = g_entry graph check facts = noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts -cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg -cmmGlobalLiveness dflags graph = - analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty +cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalReg +cmmGlobalLiveness platform graph = + analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty -- | On entry to the procedure, there had better not be any LocalReg's live-in. noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a @@ -72,10 +72,10 @@ noLiveOnEntry bid in_fact x = gen_kill :: (DefinerOfRegs r n, UserOfRegs r n) - => DynFlags -> n -> CmmLive r -> CmmLive r -gen_kill dflags node set = - let !afterKill = foldRegsDefd dflags deleteFromRegSet set node - in foldRegsUsed dflags extendRegSet afterKill node + => Platform -> n -> CmmLive r -> CmmLive r +gen_kill platform node set = + let !afterKill = foldRegsDefd platform deleteFromRegSet set node + in foldRegsUsed platform extendRegSet afterKill node {-# INLINE gen_kill #-} xferLive @@ -85,10 +85,10 @@ xferLive , UserOfRegs r (CmmNode O C) , DefinerOfRegs r (CmmNode O C) ) - => DynFlags -> TransferFun (CmmLive r) -xferLive dflags (BlockCC eNode middle xNode) fBase = - let joined = gen_kill dflags xNode $! joinOutFacts liveLattice xNode fBase - !result = foldNodesBwdOO (gen_kill dflags) middle joined + => Platform -> TransferFun (CmmLive r) +xferLive platform (BlockCC eNode middle xNode) fBase = + let joined = gen_kill platform xNode $! joinOutFacts liveLattice xNode fBase + !result = foldNodesBwdOO (gen_kill platform) middle joined in mapSingleton (entryLabel eNode) result -{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-} -{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-} +{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} +{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -31,7 +31,6 @@ import GHC.Prelude hiding (succ) import GHC.Platform.Regs import GHC.Cmm.Expr import GHC.Cmm.Switch -import GHC.Driver.Session import GHC.Data.FastString import GHC.Types.ForeignCall import GHC.Utils.Outputable @@ -320,7 +319,7 @@ foreignTargetHints target -- Instances of register and slot users / definers instance UserOfRegs LocalReg (CmmNode e x) where - foldRegsUsed dflags f !z n = case n of + foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args @@ -331,10 +330,10 @@ instance UserOfRegs LocalReg (CmmNode e x) where _ -> z where fold :: forall a b. UserOfRegs LocalReg a => (b -> LocalReg -> b) -> b -> a -> b - fold f z n = foldRegsUsed dflags f z n + fold f z n = foldRegsUsed platform f z n instance UserOfRegs GlobalReg (CmmNode e x) where - foldRegsUsed dflags f !z n = case n of + foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args @@ -345,26 +344,26 @@ instance UserOfRegs GlobalReg (CmmNode e x) where _ -> z where fold :: forall a b. UserOfRegs GlobalReg a => (b -> GlobalReg -> b) -> b -> a -> b - fold f z n = foldRegsUsed dflags f z n + fold f z n = foldRegsUsed platform f z n instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance - foldRegsUsed _ _ !z (PrimTarget _) = z - foldRegsUsed dflags f !z (ForeignTarget e _) = foldRegsUsed dflags f z e + foldRegsUsed _ _ !z (PrimTarget _) = z + foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e instance DefinerOfRegs LocalReg (CmmNode e x) where - foldRegsDefd dflags f !z n = case n of + foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall _ fs _ -> fold f z fs CmmForeignCall {res=res} -> fold f z res _ -> z where fold :: forall a b. DefinerOfRegs LocalReg a => (b -> LocalReg -> b) -> b -> a -> b - fold f z n = foldRegsDefd dflags f z n + fold f z n = foldRegsDefd platform f z n instance DefinerOfRegs GlobalReg (CmmNode e x) where - foldRegsDefd dflags f !z n = case n of + foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt) CmmCall {} -> fold f z activeRegs @@ -373,9 +372,8 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where _ -> z where fold :: forall a b. DefinerOfRegs GlobalReg a => (b -> GlobalReg -> b) -> b -> a -> b - fold f z n = foldRegsDefd dflags f z n + fold f z n = foldRegsDefd platform f z n - platform = targetPlatform dflags activeRegs = activeStgRegs platform activeCallerSavesRegs = filter (callerSaves platform) activeRegs ===================================== compiler/GHC/Cmm/Pipeline.hs ===================================== @@ -86,7 +86,7 @@ cpsTop dflags proc = ----------- Implement switches ------------------------------------------ g <- {-# SCC "createSwitchPlans" #-} - runUniqSM $ cmmImplementSwitchPlans dflags g + runUniqSM $ cmmImplementSwitchPlans (backend dflags) platform g dump Opt_D_dump_cmm_switch "Post switch plan" g ----------- Proc points ------------------------------------------------- @@ -97,7 +97,7 @@ cpsTop dflags proc = if splitting_proc_points then do pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $ - minimalProcPointSet (targetPlatform dflags) call_pps g + minimalProcPointSet platform call_pps g dumpWith dflags Opt_D_dump_cmm_proc "Proc points" FormatCMM (ppr l $$ ppr pp $$ ppr g) return pp @@ -114,7 +114,7 @@ cpsTop dflags proc = ----------- Sink and inline assignments -------------------------------- g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout] - condPass Opt_CmmSink (cmmSink dflags) g + condPass Opt_CmmSink (cmmSink platform) g Opt_D_dump_cmm_sink "Sink assignments" ------------- CAF analysis ---------------------------------------------- @@ -129,7 +129,7 @@ cpsTop dflags proc = dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" FormatCMM (ppr pp_map) g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ - splitAtProcPoints dflags l call_pps proc_points pp_map + splitAtProcPoints platform l call_pps proc_points pp_map (CmmProc h l v g) dumps Opt_D_dump_cmm_split "Post splitting" g return g @@ -355,7 +355,7 @@ dumpGraph dflags flag name g = do when (gopt Opt_DoCmmLinting dflags) $ do_lint g dumpWith dflags flag name FormatCMM (ppr g) where - do_lint g = case cmmLintGraph dflags g of + do_lint g = case cmmLintGraph (targetPlatform dflags) g of Just err -> do { fatalErrorMsg dflags err ; ghcExit dflags 1 } ===================================== compiler/GHC/Cmm/ProcPoint.hs ===================================== @@ -11,7 +11,6 @@ where import GHC.Prelude hiding (last, unzip, succ, zip) -import GHC.Driver.Session import GHC.Cmm.BlockId import GHC.Cmm.CLabel import GHC.Cmm @@ -238,9 +237,9 @@ extendPPSet platform g blocks procPoints = -- Input invariant: A block should only be reachable from a single ProcPoint. -- ToDo: use the _ret naming convention that the old code generator -- used. -- EZY -splitAtProcPoints :: DynFlags -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> +splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> CmmDecl -> UniqSM [CmmDecl] -splitAtProcPoints dflags entry_label callPPs procPoints procMap +splitAtProcPoints platform entry_label callPPs procPoints procMap (CmmProc (TopInfo {info_tbls = info_tbls}) top_l _ g@(CmmGraph {g_entry=entry})) = do -- Build a map from procpoints to the blocks they reach @@ -262,7 +261,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap where graph = mapLookup procId graphEnv `orElse` mapEmpty graph' = mapInsert bid b graph - let liveness = cmmGlobalLiveness dflags g + let liveness = cmmGlobalLiveness platform g let ppLiveness pp = filter isArgReg $ regSetToList $ expectJust "ppLiveness" $ mapLookup pp liveness @@ -316,7 +315,6 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap -- when jumping to a PP that has an info table, if -- tablesNextToCode is off we must jump to the entry -- label instead. - platform = targetPlatform dflags tablesNextToCode = platformTablesNextToCode platform jump_label (Just info_lbl) _ | tablesNextToCode = info_lbl ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -16,7 +16,6 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Driver.Session import GHC.Types.Unique import GHC.Types.Unique.FM @@ -165,10 +164,10 @@ type Assignments = [Assignment] -- y = e2 -- x = e1 -cmmSink :: DynFlags -> CmmGraph -> CmmGraph -cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks +cmmSink :: Platform -> CmmGraph -> CmmGraph +cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness dflags graph + liveness = cmmLocalLiveness platform graph getLive l = mapFindWithDefault Set.empty l liveness blocks = revPostorder graph @@ -181,7 +180,6 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- pprTrace "sink" (ppr lbl) $ blockJoin first final_middle final_last : sink sunk' bs where - platform = targetPlatform dflags lbl = entryLabel b (first, middle, last) = blockSplit b @@ -191,13 +189,13 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. live = Set.unions (map getLive succs) - live_middle = gen_kill dflags last live - ann_middles = annotate dflags live_middle (blockToList middle) + live_middle = gen_kill platform last live + ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block - (middle', assigs) = walk dflags ann_middles (mapFindWithDefault [] lbl sunk) + (middle', assigs) = walk platform ann_middles (mapFindWithDefault [] lbl sunk) fold_last = constantFoldNode platform last - (final_last, assigs') = tryToInline dflags live fold_last assigs + (final_last, assigs') = tryToInline platform live fold_last assigs -- We cannot sink into join points (successors with more than -- one predecessor), so identify the join points and the set @@ -217,12 +215,12 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks _ -> False -- Now, drop any assignments that we will not sink any further. - (dropped_last, assigs'') = dropAssignments dflags drop_if init_live_sets assigs' + (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where - should_drop = conflicts dflags a final_last - || not (isTrivial dflags rhs) && live_in_multi live_sets r + should_drop = conflicts platform a final_last + || not (isTrivial platform rhs) && live_in_multi live_sets r || r `Set.member` live_in_joins live_sets' | should_drop = live_sets @@ -231,12 +229,12 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks upd set | r `Set.member` set = set `Set.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed dflags extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last sunk' = mapUnion sunk $ - mapFromList [ (l, filterAssignments dflags (getLive l) assigs'') + mapFromList [ (l, filterAssignments platform (getLive l) assigs'') | l <- succs ] {- TODO: enable this later, when we have some good tests in place to @@ -255,12 +253,12 @@ isSmall _ = False -- We allow duplication of trivial expressions: registers (both local and -- global) and literals. -- -isTrivial :: DynFlags -> CmmExpr -> Bool +isTrivial :: Platform -> CmmExpr -> Bool isTrivial _ (CmmReg (CmmLocal _)) = True -isTrivial dflags (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?] - if isARM (platformArch (targetPlatform dflags)) +isTrivial platform (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?] + if isARM (platformArch platform) then True -- CodeGen.Platform.ARM does not have globalRegMaybe - else isJust (globalRegMaybe (targetPlatform dflags) r) + else isJust (globalRegMaybe platform r) -- GlobalRegs that are loads from BaseReg are not trivial isTrivial _ (CmmLit _) = True isTrivial _ _ = False @@ -268,9 +266,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: DynFlags -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] -annotate dflags live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill dflags n live, (live,n) : nodes) +annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate platform live nodes = snd $ foldr ann (live,[]) nodes + where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -287,14 +285,14 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: DynFlags -> LocalRegSet -> Assignments -> Assignments -filterAssignments dflags live assigs = reverse (go assigs []) +filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where needed = r `Set.member` live - || any (conflicts dflags a) (map toNode kept) + || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have -- already kept. @@ -313,7 +311,7 @@ filterAssignments dflags live assigs = reverse (go assigs []) -- * a list of assignments that will be placed *after* that block. -- -walk :: DynFlags +walk :: Platform -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -327,7 +325,7 @@ walk :: DynFlags , Assignments -- Assignments to sink further ) -walk dflags nodes assigs = go nodes emptyBlock assigs +walk platform nodes assigs = go nodes emptyBlock assigs where go [] block as = (block, as) go ((live,node):ns) block as @@ -336,13 +334,12 @@ walk dflags nodes assigs = go nodes emptyBlock assigs | Just a <- shouldSink platform node2 = go ns block (a : as1) | otherwise = go ns block' as' where - platform = targetPlatform dflags node1 = constantFoldNode platform node - (node2, as1) = tryToInline dflags live node1 as + (node2, as1) = tryToInline platform live node1 as - (dropped, as') = dropAssignmentsSimple dflags - (\a -> conflicts dflags a node2) as1 + (dropped, as') = dropAssignmentsSimple platform + (\a -> conflicts platform a node2) as1 block' = foldl' blockSnoc block dropped `blockSnoc` node2 @@ -380,13 +377,13 @@ shouldDiscard node live toNode :: Assignment -> CmmNode O O toNode (r,rhs,_) = CmmAssign (CmmLocal r) rhs -dropAssignmentsSimple :: DynFlags -> (Assignment -> Bool) -> Assignments +dropAssignmentsSimple :: Platform -> (Assignment -> Bool) -> Assignments -> ([CmmNode O O], Assignments) -dropAssignmentsSimple dflags f = dropAssignments dflags (\a _ -> (f a, ())) () +dropAssignmentsSimple platform f = dropAssignments platform (\a _ -> (f a, ())) () -dropAssignments :: DynFlags -> (Assignment -> s -> (Bool, s)) -> s -> Assignments +dropAssignments :: Platform -> (Assignment -> s -> (Bool, s)) -> s -> Assignments -> ([CmmNode O O], Assignments) -dropAssignments dflags should_drop state assigs +dropAssignments platform should_drop state assigs = (dropped, reverse kept) where (dropped,kept) = go state assigs [] [] @@ -397,7 +394,7 @@ dropAssignments dflags should_drop state assigs | otherwise = go state' rest dropped (assig:kept) where (dropit, state') = should_drop assig state - conflict = dropit || any (conflicts dflags assig) dropped + conflict = dropit || any (conflicts platform assig) dropped -- ----------------------------------------------------------------------------- @@ -406,7 +403,7 @@ dropAssignments dflags should_drop state assigs -- inlining opens up opportunities for doing so. tryToInline - :: DynFlags + :: Platform -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless @@ -418,10 +415,10 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline dflags live node assigs = go usages node emptyLRegSet assigs +tryToInline platform live node assigs = go usages node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used - usages = foldLocalRegsUsed dflags addUsage emptyUFM node + usages = foldLocalRegsUsed platform addUsage emptyUFM node go _usages node _skipped [] = (node, []) @@ -429,12 +426,11 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs | cannot_inline = dont_inline | occurs_none = discard -- Note [discard during inlining] | occurs_once = inline_and_discard - | isTrivial dflags rhs = inline_and_keep + | isTrivial platform rhs = inline_and_keep | otherwise = dont_inline where - platform = targetPlatform dflags inline_and_discard = go usages' inl_node skipped rest - where usages' = foldLocalRegsUsed dflags addUsage usages rhs + where usages' = foldLocalRegsUsed platform addUsage usages rhs discard = go usages node skipped rest @@ -443,7 +439,7 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs keep node' = (final_node, a : rest') where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest - usages' = foldLocalRegsUsed dflags (\m r -> addToUFM m r 2) + usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) usages rhs -- we must not inline anything that is mentioned in the RHS -- of a binding that we have already skipped, so we set the @@ -451,7 +447,7 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped - || not (okToInline dflags rhs node) + || not (okToInline platform rhs node) l_usages = lookupUFM usages l l_live = l `elemRegSet` live @@ -569,25 +565,25 @@ regsUsedIn ls e = wrapRecExpf f e False -- ought to be able to handle it properly, but currently neither PprC -- nor the NCG can do it. See Note [Register parameter passing] -- See also GHC.StgToCmm.Foreign.load_args_into_temps. -okToInline :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -okToInline dflags expr node@(CmmUnsafeForeignCall{}) = - not (globalRegistersConflict dflags expr node) +okToInline :: Platform -> CmmExpr -> CmmNode e x -> Bool +okToInline platform expr node@(CmmUnsafeForeignCall{}) = + not (globalRegistersConflict platform expr node) okToInline _ _ _ = True -- ----------------------------------------------------------------------------- -- | @conflicts (r,e) node@ is @False@ if and only if the assignment -- @r = e@ can be safely commuted past statement @node at . -conflicts :: DynFlags -> Assignment -> CmmNode O x -> Bool -conflicts dflags (r, rhs, addr) node +conflicts :: Platform -> Assignment -> CmmNode O x -> Bool +conflicts platform (r, rhs, addr) node -- (1) node defines registers used by rhs of assignment. This catches -- assignments and all three kinds of calls. See Note [Sinking and calls] - | globalRegistersConflict dflags rhs node = True - | localRegistersConflict dflags rhs node = True + | globalRegistersConflict platform rhs node = True + | localRegistersConflict platform rhs node = True -- (2) node uses register defined by assignment - | foldRegsUsed dflags (\b r' -> r == r' || b) False node = True + | foldRegsUsed platform (\b r' -> r == r' || b) False node = True -- (3) a store to an address conflicts with a read of the same memory | CmmStore addr' e <- node @@ -606,21 +602,19 @@ conflicts dflags (r, rhs, addr) node -- (7) otherwise, no conflict | otherwise = False - where - platform = targetPlatform dflags -- Returns True if node defines any global registers that are used in the -- Cmm expression -globalRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -globalRegistersConflict dflags expr node = - foldRegsDefd dflags (\b r -> b || regUsedIn (targetPlatform dflags) (CmmGlobal r) expr) +globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool +globalRegistersConflict platform expr node = + foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) False node -- Returns True if node defines any local registers that are used in the -- Cmm expression -localRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -localRegistersConflict dflags expr node = - foldRegsDefd dflags (\b r -> b || regUsedIn (targetPlatform dflags) (CmmLocal r) expr) +localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool +localRegistersConflict platform expr node = + foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) False node -- Note [Sinking and calls] ===================================== compiler/GHC/Cmm/Switch/Implement.hs ===================================== @@ -6,6 +6,7 @@ where import GHC.Prelude +import GHC.Driver.Backend import GHC.Platform import GHC.Cmm.Dataflow.Block import GHC.Cmm.BlockId @@ -13,7 +14,6 @@ import GHC.Cmm import GHC.Cmm.Utils import GHC.Cmm.Switch import GHC.Types.Unique.Supply -import GHC.Driver.Session import GHC.Utils.Monad (concatMapM) -- @@ -32,12 +32,12 @@ import GHC.Utils.Monad (concatMapM) -- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for -- code generation. -cmmImplementSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph -cmmImplementSwitchPlans dflags g +cmmImplementSwitchPlans :: Backend -> Platform -> CmmGraph -> UniqSM CmmGraph +cmmImplementSwitchPlans backend platform g -- Switch generation done by backend (LLVM/C) - | backendSupportsSwitch (backend dflags) = return g + | backendSupportsSwitch backend = return g | otherwise = do - blocks' <- concatMapM (visitSwitches (targetPlatform dflags)) (toBlockList g) + blocks' <- concatMapM (visitSwitches platform) (toBlockList g) return $ ofBlockList (g_entry g) blocks' visitSwitches :: Platform -> CmmBlock -> UniqSM [CmmBlock] ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -91,7 +91,7 @@ pprTop platform = \case blankLine, extern_decls, (if (externallyVisibleCLabel clbl) - then mkFN_ else mkIF_) (ppr clbl) <+> lbrace, + then mkFN_ else mkIF_) (pprCLabel_ViaC platform clbl) <+> lbrace, nest 8 temp_decls, vcat (map (pprBBlock platform) blocks), rbrace ] @@ -110,14 +110,14 @@ pprTop platform = \case (CmmData section (CmmStaticsRaw lbl [CmmString str])) -> pprExternDecl platform lbl $$ hcat [ - pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl, text "[] = ", pprStringInCStyle str, semi ] (CmmData section (CmmStaticsRaw lbl [CmmUninitialised size])) -> pprExternDecl platform lbl $$ hcat [ - pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl, brackets (int size), semi ] @@ -153,7 +153,7 @@ pprWordArray platform is_ro lbl ds = -- TODO: align closures only pprExternDecl platform lbl $$ hcat [ pprLocalness lbl, pprConstness is_ro, text "StgWord" - , space, ppr lbl, text "[]" + , space, pprCLabel_ViaC platform lbl, text "[]" -- See Note [StgWord alignment] , pprAlignment (wordWidth platform) , text "= {" ] @@ -238,7 +238,7 @@ pprStmt platform stmt = case fn of CmmLit (CmmLabel lbl) | StdCallConv <- cconv -> - pprCall platform (ppr lbl) cconv hresults hargs + pprCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs -- stdcall functions must be declared with -- a function type, otherwise the C compiler -- doesn't add the @n suffix to the label. We @@ -247,7 +247,7 @@ pprStmt platform stmt = | CmmNeverReturns <- ret -> pprCall platform cast_fn cconv hresults hargs <> semi | not (isMathFun lbl) -> - pprForeignCall platform (ppr lbl) cconv hresults hargs + pprForeignCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs _ -> pprCall platform cast_fn cconv hresults hargs <> semi -- for a dynamic call, no declaration is necessary. @@ -487,7 +487,7 @@ pprLit platform lit = case lit of -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i where - pprCLabelAddr lbl = char '&' <> ppr lbl + pprCLabelAddr lbl = char '&' <> pprCLabel_ViaC platform lbl pprLit1 :: Platform -> CmmLit -> SDoc pprLit1 platform lit = case lit of @@ -1047,7 +1047,7 @@ pprExternDecl platform lbl | not (needsCDecl lbl) = empty | Just sz <- foreignLabelStdcallInfo lbl = stdcall_decl sz | otherwise = - hcat [ visibility, label_type lbl , lparen, ppr lbl, text ");" + hcat [ visibility, label_type lbl , lparen, pprCLabel_ViaC platform lbl, text ");" -- occasionally useful to see label type -- , text "/* ", pprDebugCLabel lbl, text " */" ] @@ -1070,7 +1070,7 @@ pprExternDecl platform lbl -- we must generate an appropriate prototype for it, so that the C compiler will -- add the @n suffix to the label (#2276) stdcall_decl sz = - text "extern __attribute__((stdcall)) void " <> ppr lbl + text "extern __attribute__((stdcall)) void " <> pprCLabel_ViaC platform lbl <> parens (commafy (replicate (sz `quot` platformWordSizeInBytes platform) (machRep_U_CType platform (wordWidth platform)))) <> semi ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -51,8 +51,9 @@ module GHC.Core.DataCon ( splitDataProductType_maybe, -- ** Predicates on DataCons - isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon, - isUnboxedSumCon, + isNullarySrcDataCon, isNullaryRepDataCon, + isTupleDataCon, isBoxedTupleDataCon, isUnboxedTupleDataCon, + isUnboxedSumDataCon, isVanillaDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsArePermuted, isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked, @@ -1467,11 +1468,14 @@ dataConIdentity dc = LBS.toStrict $ BSB.toLazyByteString $ mconcat isTupleDataCon :: DataCon -> Bool isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc -isUnboxedTupleCon :: DataCon -> Bool -isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc +isBoxedTupleDataCon :: DataCon -> Bool +isBoxedTupleDataCon (MkData {dcRepTyCon = tc}) = isBoxedTupleTyCon tc -isUnboxedSumCon :: DataCon -> Bool -isUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc +isUnboxedTupleDataCon :: DataCon -> Bool +isUnboxedTupleDataCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc + +isUnboxedSumDataCon :: DataCon -> Bool +isUnboxedSumDataCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc -- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors isVanillaDataCon :: DataCon -> Bool ===================================== compiler/GHC/Core/DataCon.hs-boot ===================================== @@ -26,7 +26,7 @@ dataConInstOrigArgTys :: DataCon -> [Type] -> [Scaled Type] dataConStupidTheta :: DataCon -> ThetaType dataConFullSig :: DataCon -> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Scaled Type], Type) -isUnboxedSumCon :: DataCon -> Bool +isUnboxedSumDataCon :: DataCon -> Bool instance Eq DataCon instance Uniquable DataCon ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -359,7 +359,7 @@ forcesRealWorld fam_envs ty = True | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } <- deepSplitProductType_maybe fam_envs ty - , isUnboxedTupleCon dc + , isUnboxedTupleDataCon dc = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys | otherwise = False ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Core.Coercion.Opt ( optCoercion ) import GHC.Core.FamInstEnv ( topNormaliseType_maybe ) import GHC.Core.DataCon ( DataCon, dataConWorkId, dataConRepStrictness - , dataConRepArgTys, isUnboxedTupleCon + , dataConRepArgTys, isUnboxedTupleDataCon , StrictnessMark (..) ) import GHC.Core.Opt.Monad ( Tick(..), SimplMode(..) ) import GHC.Core @@ -2957,7 +2957,7 @@ addEvals :: Maybe OutExpr -> DataCon -> [Id] -> [Id] addEvals scrut con vs -- Deal with seq# applications | Just scr <- scrut - , isUnboxedTupleCon con + , isUnboxedTupleDataCon con , [s,x] <- vs -- Use stripNArgs rather than collectArgsTicks to avoid building -- a list of arguments only to throw it away immediately. ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -148,7 +148,7 @@ import {-# SOURCE #-} GHC.Builtin.Types import {-# SOURCE #-} GHC.Core.DataCon ( DataCon, dataConExTyCoVars, dataConFieldLabels , dataConTyCon, dataConFullSig - , isUnboxedSumCon ) + , isUnboxedSumDataCon ) import GHC.Builtin.Uniques ( tyConRepNameUnique , dataConTyRepNameUnique ) @@ -1323,7 +1323,7 @@ tyConRepName_maybe (AlgTyCon { algTcParent = parent }) tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm }) = Just rep_nm tyConRepName_maybe (PromotedDataCon { dataCon = dc, tcRepName = rep_nm }) - | isUnboxedSumCon dc -- see #13276 + | isUnboxedSumDataCon dc -- see #13276 = Nothing | otherwise = Just rep_nm ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -889,7 +889,7 @@ conSize dc n_val_args | n_val_args == 0 = SizeIs 0 emptyBag 10 -- Like variables -- See Note [Unboxed tuple size and result discount] - | isUnboxedTupleCon dc = SizeIs 0 emptyBag 10 + | isUnboxedTupleDataCon dc = SizeIs 0 emptyBag 10 -- See Note [Constructor size and result discount] | otherwise = SizeIs 10 emptyBag 10 ===================================== compiler/GHC/CoreToByteCode.hs ===================================== @@ -648,7 +648,7 @@ schemeE d s p (AnnCase (_,scrut) _ _ []) = schemeE d s p scrut -- handle pairs with one void argument (e.g. state token) schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)]) - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc -- Convert -- case .... of x { (# V'd-thing, a #) -> ... } -- to @@ -667,7 +667,7 @@ schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)]) -- handle unit tuples schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)]) - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc , typePrimRep (idType bndr) `lengthAtMost` 1 = doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr) @@ -825,7 +825,7 @@ schemeT d s p app -- Case 2: Constructor application | Just con <- maybe_saturated_dcon - , isUnboxedTupleCon con + , isUnboxedTupleDataCon con = case args_r_to_l of [arg1,arg2] | isVAtom arg1 -> unboxedTupleReturn d s p arg2 @@ -1090,7 +1090,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} my_discr (DataAlt dc, _, _) - | isUnboxedTupleCon dc || isUnboxedSumCon dc + | isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc = multiValException | otherwise = DiscrP (fromIntegral (dataConTag dc - fIRST_TAG)) ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -188,7 +188,7 @@ toIfaceTypeX fr (TyConApp tc tys) = IfaceTupleTy sort NotPromoted (toIfaceTcArgsX fr tc tys) | Just dc <- isPromotedDataCon_maybe tc - , isTupleDataCon dc + , isBoxedTupleDataCon dc , n_tys == 2*arity = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys)) ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -699,7 +699,7 @@ mkTopStgRhs dflags this_mod ccs bndr rhs , -- Dynamic StgConApps are updatable not (isDllConApp dflags this_mod con args) = -- CorePrep does this right, but just to make sure - ASSERT2( not (isUnboxedTupleCon con || isUnboxedSumCon con) + ASSERT2( not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) , ppr bndr $$ ppr con $$ ppr args) ( StgRhsCon dontCareCCS con args, ccs ) ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -83,7 +83,7 @@ codeOutput dflags this_mod filenm location foreign_stubs foreign_fps pkg_deps dflags (text "CmmLint"<+>brackets (ppr this_mod)) (const ()) $ do - { case cmmLint dflags cmm of + { case cmmLint (targetPlatform dflags) cmm of Just err -> do { log_action dflags dflags NoReason ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -172,7 +172,7 @@ pprConLike delta _prec cl args WcVarTerminated pref x -> parens . fcat . punctuate colon <$> mapM (pprPmVar appPrec) (toList pref ++ [x]) pprConLike _delta _prec (RealDataCon con) args - | isUnboxedTupleCon con + | isUnboxedTupleDataCon con , let hash_parens doc = text "(#" <+> doc <+> text "#)" = hash_parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args | isTupleDataCon con ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -164,7 +164,7 @@ lintStgRhs (StgRhsClosure _ _ _ binders expr) lintStgExpr expr lintStgRhs rhs@(StgRhsCon _ con args) = do - when (isUnboxedTupleCon con || isUnboxedSumCon con) $ do + when (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) $ do opts <- getStgPprOpts addErrL (text "StgRhsCon is an unboxed tuple or sum application" $$ pprStgRhs opts rhs) @@ -182,7 +182,7 @@ lintStgExpr (StgApp fun args) = do lintStgExpr app@(StgConApp con args _arg_tys) = do -- unboxed sums should vanish during unarise lf <- getLintFlags - when (lf_unarised lf && isUnboxedSumCon con) $ do + when (lf_unarised lf && isUnboxedSumDataCon con) $ do opts <- getStgPprOpts addErrL (text "Unboxed sum after unarise:" $$ pprStgExpr opts app) ===================================== compiler/GHC/Stg/Unarise.hs ===================================== @@ -294,7 +294,7 @@ unariseRhs rho (StgRhsClosure ext ccs update_flag args expr) return (StgRhsClosure ext ccs update_flag args1 expr') unariseRhs rho (StgRhsCon ccs con args) - = ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con)) + = ASSERT(not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con)) return (StgRhsCon ccs con (unariseConArgs rho args)) -------------------------------------------------------------------------------- @@ -372,10 +372,10 @@ unariseExpr rho (StgTick tick e) -- Doesn't return void args. unariseMulti_maybe :: UnariseEnv -> DataCon -> [InStgArg] -> [Type] -> Maybe [OutStgArg] unariseMulti_maybe rho dc args ty_args - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc = Just (unariseConArgs rho args) - | isUnboxedSumCon dc + | isUnboxedSumDataCon dc , let args1 = ASSERT(isSingleton args) (unariseConArgs rho args) = Just (mkUbxSum dc ty_args args1) ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -354,7 +354,7 @@ bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg] -- binders args, assuming that we have just returned from a 'case' which -- found a con bindConArgs (DataAlt con) base args - = ASSERT(not (isUnboxedTupleCon con)) + = ASSERT(not (isUnboxedTupleDataCon con)) do profile <- getProfile platform <- getPlatform let (_, _, args_w_offsets) = mkVirtConstrOffsets profile (addIdReps args) ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -837,7 +837,7 @@ maybeAltHeapCheck (GcInAlts regs, ReturnedTo lret off) code = cgConApp :: DataCon -> [StgArg] -> FCode ReturnKind cgConApp con stg_args - | isUnboxedTupleCon con -- Unboxed tuple: assign and return + | isUnboxedTupleDataCon con -- Unboxed tuple: assign and return = do { arg_exprs <- getNonVoidArgAmodes stg_args ; tickyUnboxedTupleReturn (length arg_exprs) ; emitReturn arg_exprs } ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -556,7 +556,7 @@ hasNoBinding :: Id -> Bool hasNoBinding id = case Var.idDetails id of PrimOpId _ -> True -- See Note [Eta expanding primops] in GHC.Builtin.PrimOps FCallId _ -> True - DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc + DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc _ -> isCompulsoryUnfolding (idUnfolding id) -- See Note [Levity-polymorphic Ids] ===================================== testsuite/tests/ghci/scripts/T18644.script ===================================== @@ -0,0 +1,3 @@ +:set -XDataKinds -XUnboxedTuples +:kind! '(# #) +:kind! '() ===================================== testsuite/tests/ghci/scripts/T18644.stdout ===================================== @@ -0,0 +1,4 @@ +'(# #) :: (# #) += '(# #) +'() :: () += '() ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -315,3 +315,4 @@ test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script']) +test('T18644', normal, ghci_script, ['T18644.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04933454bfd0d4f7b23c9cecc845877d0f716468...ff8a6dead9e72d684d906346504ca0de30fa473a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/04933454bfd0d4f7b23c9cecc845877d0f716468...ff8a6dead9e72d684d906346504ca0de30fa473a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 08:12:59 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Fri, 04 Sep 2020 04:12:59 -0400 Subject: [Git][ghc/ghc][wip/angerman/fix-rpath] [macOS] improved runpath handling Message-ID: <5f51f70ba1b84_80b3f84862f6d50105183d4@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/fix-rpath at Glasgow Haskell Compiler / GHC Commits: 89a75330 by Moritz Angermann at 2020-09-04T16:12:36+08:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - 16 changed files: - aclocal.m4 - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - docs/users_guide/phases.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - mk/config.mk.in - testsuite/tests/rts/all.T Changes: ===================================== aclocal.m4 ===================================== @@ -579,6 +579,18 @@ AC_DEFUN([FP_SETTINGS], else SettingsOptCommand="$OptCmd" fi + if test -z "$OtoolCmd" + then + SettingsOtoolCommand="otool" + else + SettingsOtoolCommand="$OtoolCmd" + fi + if test -z "$InstallNameToolCmd" + then + SettingsInstallNameToolCommand="install_name_tool" + else + SettingsInstallNameToolCommand="$InstallNameToolCmd" + fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -596,6 +608,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -394,7 +394,56 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commands. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc's ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1787,9 +1836,12 @@ linkBinary' staticLink dflags o_files dep_units = do rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then GHC.SysTools.runLibtool - else GHC.SysTools.runLink + let link dflags args | staticLink = GHC.SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = GHC.SysTools.runLink dflags args >> GHC.SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = GHC.SysTools.runLink dflags args + link dflags ( map GHC.SysTools.Option verbFlags ++ [ GHC.SysTools.Option "-o" @@ -1856,7 +1908,13 @@ linkBinary' staticLink dflags o_files dep_units = do ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -145,8 +145,8 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, + pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool, + pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -885,6 +885,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags +pgm_otool :: DynFlags -> String +pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) @@ -2267,6 +2271,10 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } + , make_ord_flag defFlag "pgmotool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f} + , make_ord_flag defFlag "pgminstall_name_tool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f} , make_ord_flag defFlag "pgmranlib" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } @@ -3780,7 +3788,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -3791,6 +3798,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -3831,6 +3840,29 @@ default_PIC platform = -- information. _ -> [] + +-- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS +-- versions the number of load commands we can embed in a dynamic library is +-- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only +-- link the needed dylibs instead of linking the full dependency closure. +-- +-- If we split the library linking into injecting -rpath and -l @rpath/... +-- components, we will reduce the number of libraries we link, however we will +-- still inject one -rpath entry for each library, independent of their use. +-- That is, we even inject -rpath values for libraries that we dead_strip in +-- the end. As such we can run afoul of the load command size limit simply +-- by polluting the load commands with RPATH entries. +-- +-- Thus, we disable Opt_RPath by default on OSDarwin. The savvy user can always +-- enable it with -use-rpath if they so wish. +-- +-- See Note [Dynamic linking on macOS] + +default_RPath :: Platform -> [GeneralFlag] +default_RPath platform | platformOS platform == OSDarwin = [] +default_RPath _ = [Opt_RPath] + + -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -929,20 +929,22 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,6 +34,8 @@ module GHC.Settings , sPgm_windres , sPgm_libtool , sPgm_ar + , sPgm_otool + , sPgm_install_name_tool , sPgm_ranlib , sPgm_lo , sPgm_lc @@ -107,6 +109,8 @@ data ToolSettings = ToolSettings , toolSettings_pgm_windres :: String , toolSettings_pgm_libtool :: String , toolSettings_pgm_ar :: String + , toolSettings_pgm_otool :: String + , toolSettings_pgm_install_name_tool :: String , toolSettings_pgm_ranlib :: String , -- | LLVM: opt llvm optimiser toolSettings_pgm_lo :: (String, [Option]) @@ -216,6 +220,10 @@ sPgm_libtool :: Settings -> String sPgm_libtool = toolSettings_pgm_libtool . sToolSettings sPgm_ar :: Settings -> String sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_otool :: Settings -> String +sPgm_otool = toolSettings_pgm_otool . sToolSettings +sPgm_install_name_tool :: Settings -> String +sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings sPgm_ranlib :: Settings -> String sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings sPgm_lo :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -115,6 +115,8 @@ initSettings top_dir = do windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -191,6 +193,8 @@ initSettings top_dir = do , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) ===================================== compiler/GHC/SysTools.hs ===================================== @@ -259,7 +259,10 @@ linkDynLib dflags0 o_files dep_packages | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `Set.member` ways dflags + -- Only if we want dynamic libraries + WayDyn `Set.member` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -384,8 +387,15 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the leftover + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -28,6 +28,10 @@ import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pa import GHC.SysTools.Process import GHC.SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,41 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included in the load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of libraries end up being truely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath at . +-- +-- See Note [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + -- find any pre-existing LC_PATH items + info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib] + let paths = concatMap f info + where f ("path":p:_) = [p] + f _ = [] + lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ] + -- only find those rpaths, that aren't already in the library. + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths') + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -329,6 +368,17 @@ runAr dflags cwd args = traceToolCommand dflags "ar" $ do let ar = pgm_ar dflags runSomethingFiltered dflags id "Ar" ar args cwd Nothing +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing + runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do let ranlib = pgm_ranlib dflags ===================================== configure.ac ===================================== @@ -697,6 +697,18 @@ else fi AC_SUBST([LibtoolCmd]) +dnl ** Which otool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([OTOOL], [otool]) +OtoolCmd="$OTOOL" +AC_SUBST(OtoolCmd) + +dnl ** Which install_name_tool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool]) +InstallNameToolCmd="$INSTALL_NAME_TOOL" +AC_SUBST(InstallNameToolCmd) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -1520,6 +1532,8 @@ echo "\ libtool : $LibtoolCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd + otool : $OtoolCmd + install_name_tool : $InstallNameToolCmd windres : $WindresCmd dllwrap : $DllWrapCmd genlib : $GenlibCmd ===================================== docs/users_guide/phases.rst ===================================== @@ -95,6 +95,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only). +.. ghc-flag:: -pgmotool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inspect mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and + executables to read the dynamic library dependencies. We will compute + the necessary ``runpath``s to embed for the dependencies based on the + result of the ``otool`` call. + +.. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inject ``runpath`` into mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inject ``runpath``s into mach-o dynamic + libraries and executables. As detected by the ``otool`` call. + .. ghc-flag:: -pgmwindres ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the program for embedding manifests on Windows. :type: dynamic ===================================== hadrian/cfg/system.config.in ===================================== @@ -151,6 +151,8 @@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ +settings-otool-command = @SettingsOtoolCommand@ +settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-libtool-command = @SettingsLibtoolCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -114,6 +114,8 @@ data SettingsFileSetting | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_OtoolCommand + | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_LibtoolCommand @@ -200,6 +202,8 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_OtoolCommand -> "settings-otool-command" + SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -308,6 +308,8 @@ generateSettings = do , ("ar flags", expr $ lookupValueOrError configFile "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) ===================================== includes/ghc.mk ===================================== @@ -233,6 +233,8 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ + @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -504,6 +504,8 @@ SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ ===================================== testsuite/tests/rts/all.T ===================================== @@ -406,7 +406,7 @@ test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp - test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug']) test('T13676', - [when(opsys('darwin') or opsys('mingw32'), expect_broken(17447)), + [when(opsys('mingw32'), expect_broken(17447)), extra_files(['T13676.hs'])], ghci_script, ['T13676.script']) test('InitEventLogging', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89a753308deb2c7ed012e875e220b1d39e1798d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/89a753308deb2c7ed012e875e220b1d39e1798d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 09:04:00 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Sep 2020 05:04:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Don't rely on CLabel's Outputable instance in CmmToC Message-ID: <5f5203004d23a_80b3f849c232c64105349fb@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8166769f by Sylvain Henry at 2020-09-04T05:03:47-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 8f5f5cf2 by Sylvain Henry at 2020-09-04T05:03:48-04:00 DynFlags: use Platform in foldRegs* - - - - - 91e74adc by Sylvain Henry at 2020-09-04T05:03:48-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - d54d95bc by Ryan Scott at 2020-09-04T05:03:49-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Types/Id.hs - + testsuite/tests/ghci/scripts/T18644.script - + testsuite/tests/ghci/scripts/T18644.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -108,7 +108,7 @@ module GHC.Cmm.CLabel ( -- * Conversions toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName, - pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, + pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, pprCLabel_ViaC, isInfoTableLabel, isConInfoTableLabel, isIdLabel, isTickyLabel @@ -1218,11 +1218,15 @@ pprCLabel bcknd platform lbl = case bcknd of NCG -> pprCLabel_NCG platform lbl LLVM -> pprCLabel_LLVM platform lbl + ViaC -> pprCLabel_ViaC platform lbl _ -> pprCLabel_other platform lbl pprCLabel_LLVM :: Platform -> CLabel -> SDoc pprCLabel_LLVM = pprCLabel_NCG +pprCLabel_ViaC :: Platform -> CLabel -> SDoc +pprCLabel_ViaC = pprCLabel_other + pprCLabel_NCG :: Platform -> CLabel -> SDoc pprCLabel_NCG platform lbl = getPprStyle $ \sty -> let @@ -1348,7 +1352,13 @@ pprCLabel_common platform = \case (ForeignLabel str _ _ _) -> ftext str - (IdLabel name _cafs flavor) -> internalNamePrefix platform name <> ppr name <> ppIdFlavor flavor + (IdLabel name _cafs flavor) -> internalNamePrefix <> ppr name <> ppIdFlavor flavor + where + isRandomGenerated = not (isExternalName name) + internalNamePrefix = getPprStyle $ \ sty -> + if asmStyle sty && isRandomGenerated + then ptext (asmTempLabelPrefix platform) + else empty (CC_Label cc) -> ppr cc (CCS_Label ccs) -> ppr ccs @@ -1389,15 +1399,6 @@ instance Outputable ForeignLabelSource where ForeignLabelInThisPackage -> parens $ text "this package" ForeignLabelInExternalPackage -> parens $ text "external package" -internalNamePrefix :: Platform -> Name -> SDoc -internalNamePrefix platform name = getPprStyle $ \ sty -> - if asmStyle sty && isRandomGenerated then - ptext (asmTempLabelPrefix platform) - else - empty - where - isRandomGenerated = not $ isExternalName name - tempLabelPrefixOrUnderscore :: Platform -> SDoc tempLabelPrefixOrUnderscore platform = getPprStyle $ \ sty -> ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -38,7 +38,6 @@ import GHC.Cmm.BlockId import GHC.Cmm.CLabel import GHC.Cmm.MachOp import GHC.Cmm.Type -import GHC.Driver.Session import GHC.Utils.Panic (panic) import GHC.Types.Unique @@ -331,17 +330,17 @@ sizeRegSet = Set.size regSetToList = Set.toList class Ord r => UserOfRegs r a where - foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b + foldRegsUsed :: Platform -> (b -> r -> b) -> b -> a -> b foldLocalRegsUsed :: UserOfRegs LocalReg a - => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b + => Platform -> (b -> LocalReg -> b) -> b -> a -> b foldLocalRegsUsed = foldRegsUsed class Ord r => DefinerOfRegs r a where - foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b + foldRegsDefd :: Platform -> (b -> r -> b) -> b -> a -> b foldLocalRegsDefd :: DefinerOfRegs LocalReg a - => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b + => Platform -> (b -> LocalReg -> b) -> b -> a -> b foldLocalRegsDefd = foldRegsDefd instance UserOfRegs LocalReg CmmReg where @@ -369,20 +368,20 @@ instance Ord r => DefinerOfRegs r r where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance - foldRegsUsed dflags f !z e = expr z e + foldRegsUsed platform f !z e = expr z e where expr z (CmmLit _) = z - expr z (CmmLoad addr _) = foldRegsUsed dflags f z addr - expr z (CmmReg r) = foldRegsUsed dflags f z r - expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs - expr z (CmmRegOff r _) = foldRegsUsed dflags f z r + expr z (CmmLoad addr _) = foldRegsUsed platform f z addr + expr z (CmmReg r) = foldRegsUsed platform f z r + expr z (CmmMachOp _ exprs) = foldRegsUsed platform f z exprs + expr z (CmmRegOff r _) = foldRegsUsed platform f z r expr z (CmmStackSlot _ _) = z instance UserOfRegs r a => UserOfRegs r [a] where - foldRegsUsed dflags f set as = foldl' (foldRegsUsed dflags f) set as + foldRegsUsed platform f set as = foldl' (foldRegsUsed platform f) set as {-# INLINABLE foldRegsUsed #-} instance DefinerOfRegs r a => DefinerOfRegs r [a] where - foldRegsDefd dflags f set as = foldl' (foldRegsDefd dflags f) set as + foldRegsDefd platform f set as = foldl' (foldRegsDefd platform f) set as {-# INLINABLE foldRegsDefd #-} ----------------------------------------------------------------------------- ===================================== compiler/GHC/Cmm/LayoutStack.hs ===================================== @@ -246,9 +246,10 @@ cmmLayoutStack dflags procpoints entry_args = do -- We need liveness info. Dead assignments are removed later -- by the sinking pass. - let liveness = cmmLocalLiveness dflags graph + let liveness = cmmLocalLiveness platform graph blocks = revPostorder graph - profile = targetProfile dflags + profile = targetProfile dflags + platform = profilePlatform profile (final_stackmaps, _final_high_sp, new_blocks) <- mfix $ \ ~(rec_stackmaps, rec_high_sp, _new_blocks) -> @@ -256,7 +257,7 @@ cmmLayoutStack dflags procpoints entry_args rec_stackmaps rec_high_sp blocks blocks_with_reloads <- - insertReloadsAsNeeded dflags procpoints final_stackmaps entry new_blocks + insertReloadsAsNeeded platform procpoints final_stackmaps entry new_blocks new_blocks' <- mapM (lowerSafeForeignCall profile) blocks_with_reloads return (ofBlockList entry new_blocks', final_stackmaps) @@ -1044,30 +1045,29 @@ stackMapToLiveness platform StackMap{..} = -- ----------------------------------------------------------------------------- insertReloadsAsNeeded - :: DynFlags + :: Platform -> ProcPointSet -> LabelMap StackMap -> BlockId -> [CmmBlock] -> UniqSM [CmmBlock] -insertReloadsAsNeeded dflags procpoints final_stackmaps entry blocks = do +insertReloadsAsNeeded platform procpoints final_stackmaps entry blocks = do toBlockList . fst <$> rewriteCmmBwd liveLattice rewriteCC (ofBlockList entry blocks) mapEmpty where rewriteCC :: RewriteFun CmmLocalLive rewriteCC (BlockCC e_node middle0 x_node) fact_base0 = do let entry_label = entryLabel e_node - platform = targetPlatform dflags stackmap = case mapLookup entry_label final_stackmaps of Just sm -> sm Nothing -> panic "insertReloadsAsNeeded: rewriteCC: stackmap" -- Merge the liveness from successor blocks and analyse the last -- node. - joined = gen_kill dflags x_node $! + joined = gen_kill platform x_node $! joinOutFacts liveLattice x_node fact_base0 -- What is live at the start of middle0. - live_at_middle0 = foldNodesBwdOO (gen_kill dflags) middle0 joined + live_at_middle0 = foldNodesBwdOO (gen_kill platform) middle0 joined -- If this is a procpoint we need to add the reloads, but only if -- they're actually live. Furthermore, nothing is live at the entry ===================================== compiler/GHC/Cmm/Lint.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Cmm.Liveness import GHC.Cmm.Switch (switchTargetsToList) import GHC.Cmm.Ppr () -- For Outputable instances import GHC.Utils.Outputable -import GHC.Driver.Session import Control.Monad (ap, unless) @@ -39,37 +38,38 @@ import Control.Monad (ap, unless) -- Exported entry points: cmmLint :: (Outputable d, Outputable h) - => DynFlags -> GenCmmGroup d h CmmGraph -> Maybe SDoc -cmmLint dflags tops = runCmmLint dflags (mapM_ (lintCmmDecl dflags)) tops + => Platform -> GenCmmGroup d h CmmGraph -> Maybe SDoc +cmmLint platform tops = runCmmLint platform (mapM_ lintCmmDecl) tops -cmmLintGraph :: DynFlags -> CmmGraph -> Maybe SDoc -cmmLintGraph dflags g = runCmmLint dflags (lintCmmGraph dflags) g +cmmLintGraph :: Platform -> CmmGraph -> Maybe SDoc +cmmLintGraph platform g = runCmmLint platform lintCmmGraph g -runCmmLint :: Outputable a => DynFlags -> (a -> CmmLint b) -> a -> Maybe SDoc -runCmmLint dflags l p = - case unCL (l p) dflags of +runCmmLint :: Outputable a => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc +runCmmLint platform l p = + case unCL (l p) platform of Left err -> Just (vcat [text "Cmm lint error:", nest 2 err, text "Program was:", nest 2 (ppr p)]) Right _ -> Nothing -lintCmmDecl :: DynFlags -> GenCmmDecl h i CmmGraph -> CmmLint () -lintCmmDecl dflags (CmmProc _ lbl _ g) - = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph dflags g -lintCmmDecl _ (CmmData {}) +lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint () +lintCmmDecl (CmmProc _ lbl _ g) + = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph g +lintCmmDecl (CmmData {}) = return () -lintCmmGraph :: DynFlags -> CmmGraph -> CmmLint () -lintCmmGraph dflags g = - cmmLocalLiveness dflags g `seq` mapM_ (lintCmmBlock labels) blocks - -- cmmLiveness throws an error if there are registers - -- live on entry to the graph (i.e. undefined - -- variables) - where - blocks = toBlockList g - labels = setFromList (map entryLabel blocks) +lintCmmGraph :: CmmGraph -> CmmLint () +lintCmmGraph g = do + platform <- getPlatform + let + blocks = toBlockList g + labels = setFromList (map entryLabel blocks) + cmmLocalLiveness platform g `seq` mapM_ (lintCmmBlock labels) blocks + -- cmmLiveness throws an error if there are registers + -- live on entry to the graph (i.e. undefined + -- variables) lintCmmBlock :: LabelSet -> CmmBlock -> CmmLint () @@ -225,9 +225,9 @@ lintTarget (PrimTarget {}) = return () mayNotMentionCallerSavedRegs :: (UserOfRegs GlobalReg a, Outputable a) => SDoc -> a -> CmmLint () mayNotMentionCallerSavedRegs what thing = do - dflags <- getDynFlags - let badRegs = filter (callerSaves (targetPlatform dflags)) - $ foldRegsUsed dflags (flip (:)) [] thing + platform <- getPlatform + let badRegs = filter (callerSaves platform) + $ foldRegsUsed platform (flip (:)) [] thing unless (null badRegs) $ cmmLintErr (what <+> text "mentions caller-saved registers: " <> ppr badRegs $$ ppr thing) @@ -243,7 +243,7 @@ checkCond _ expr -- just a basic error monad: -newtype CmmLint a = CmmLint { unCL :: DynFlags -> Either SDoc a } +newtype CmmLint a = CmmLint { unCL :: Platform -> Either SDoc a } deriving (Functor) instance Applicative CmmLint where @@ -251,23 +251,20 @@ instance Applicative CmmLint where (<*>) = ap instance Monad CmmLint where - CmmLint m >>= k = CmmLint $ \dflags -> - case m dflags of + CmmLint m >>= k = CmmLint $ \platform -> + case m platform of Left e -> Left e - Right a -> unCL (k a) dflags - -instance HasDynFlags CmmLint where - getDynFlags = CmmLint (\dflags -> Right dflags) + Right a -> unCL (k a) platform getPlatform :: CmmLint Platform -getPlatform = targetPlatform <$> getDynFlags +getPlatform = CmmLint $ \platform -> Right platform cmmLintErr :: SDoc -> CmmLint a cmmLintErr msg = CmmLint (\_ -> Left msg) addLintInfo :: SDoc -> CmmLint a -> CmmLint a -addLintInfo info thing = CmmLint $ \dflags -> - case unCL thing dflags of +addLintInfo info thing = CmmLint $ \platform -> + case unCL thing platform of Left err -> Left (hang info 2 err) Right a -> Right a ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -14,7 +14,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Platform import GHC.Cmm.BlockId import GHC.Cmm import GHC.Cmm.Ppr.Expr () -- For Outputable instances @@ -52,17 +52,17 @@ type BlockEntryLiveness r = LabelMap (CmmLive r) -- | Calculated liveness info for a CmmGraph ----------------------------------------------------------------------------- -cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg -cmmLocalLiveness dflags graph = - check $ analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty +cmmLocalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg +cmmLocalLiveness platform graph = + check $ analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty where entry = g_entry graph check facts = noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts -cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg -cmmGlobalLiveness dflags graph = - analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty +cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalReg +cmmGlobalLiveness platform graph = + analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty -- | On entry to the procedure, there had better not be any LocalReg's live-in. noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a @@ -72,10 +72,10 @@ noLiveOnEntry bid in_fact x = gen_kill :: (DefinerOfRegs r n, UserOfRegs r n) - => DynFlags -> n -> CmmLive r -> CmmLive r -gen_kill dflags node set = - let !afterKill = foldRegsDefd dflags deleteFromRegSet set node - in foldRegsUsed dflags extendRegSet afterKill node + => Platform -> n -> CmmLive r -> CmmLive r +gen_kill platform node set = + let !afterKill = foldRegsDefd platform deleteFromRegSet set node + in foldRegsUsed platform extendRegSet afterKill node {-# INLINE gen_kill #-} xferLive @@ -85,10 +85,10 @@ xferLive , UserOfRegs r (CmmNode O C) , DefinerOfRegs r (CmmNode O C) ) - => DynFlags -> TransferFun (CmmLive r) -xferLive dflags (BlockCC eNode middle xNode) fBase = - let joined = gen_kill dflags xNode $! joinOutFacts liveLattice xNode fBase - !result = foldNodesBwdOO (gen_kill dflags) middle joined + => Platform -> TransferFun (CmmLive r) +xferLive platform (BlockCC eNode middle xNode) fBase = + let joined = gen_kill platform xNode $! joinOutFacts liveLattice xNode fBase + !result = foldNodesBwdOO (gen_kill platform) middle joined in mapSingleton (entryLabel eNode) result -{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-} -{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-} +{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} +{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -31,7 +31,6 @@ import GHC.Prelude hiding (succ) import GHC.Platform.Regs import GHC.Cmm.Expr import GHC.Cmm.Switch -import GHC.Driver.Session import GHC.Data.FastString import GHC.Types.ForeignCall import GHC.Utils.Outputable @@ -320,7 +319,7 @@ foreignTargetHints target -- Instances of register and slot users / definers instance UserOfRegs LocalReg (CmmNode e x) where - foldRegsUsed dflags f !z n = case n of + foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args @@ -331,10 +330,10 @@ instance UserOfRegs LocalReg (CmmNode e x) where _ -> z where fold :: forall a b. UserOfRegs LocalReg a => (b -> LocalReg -> b) -> b -> a -> b - fold f z n = foldRegsUsed dflags f z n + fold f z n = foldRegsUsed platform f z n instance UserOfRegs GlobalReg (CmmNode e x) where - foldRegsUsed dflags f !z n = case n of + foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args @@ -345,26 +344,26 @@ instance UserOfRegs GlobalReg (CmmNode e x) where _ -> z where fold :: forall a b. UserOfRegs GlobalReg a => (b -> GlobalReg -> b) -> b -> a -> b - fold f z n = foldRegsUsed dflags f z n + fold f z n = foldRegsUsed platform f z n instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance - foldRegsUsed _ _ !z (PrimTarget _) = z - foldRegsUsed dflags f !z (ForeignTarget e _) = foldRegsUsed dflags f z e + foldRegsUsed _ _ !z (PrimTarget _) = z + foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e instance DefinerOfRegs LocalReg (CmmNode e x) where - foldRegsDefd dflags f !z n = case n of + foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall _ fs _ -> fold f z fs CmmForeignCall {res=res} -> fold f z res _ -> z where fold :: forall a b. DefinerOfRegs LocalReg a => (b -> LocalReg -> b) -> b -> a -> b - fold f z n = foldRegsDefd dflags f z n + fold f z n = foldRegsDefd platform f z n instance DefinerOfRegs GlobalReg (CmmNode e x) where - foldRegsDefd dflags f !z n = case n of + foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt) CmmCall {} -> fold f z activeRegs @@ -373,9 +372,8 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where _ -> z where fold :: forall a b. DefinerOfRegs GlobalReg a => (b -> GlobalReg -> b) -> b -> a -> b - fold f z n = foldRegsDefd dflags f z n + fold f z n = foldRegsDefd platform f z n - platform = targetPlatform dflags activeRegs = activeStgRegs platform activeCallerSavesRegs = filter (callerSaves platform) activeRegs ===================================== compiler/GHC/Cmm/Pipeline.hs ===================================== @@ -86,7 +86,7 @@ cpsTop dflags proc = ----------- Implement switches ------------------------------------------ g <- {-# SCC "createSwitchPlans" #-} - runUniqSM $ cmmImplementSwitchPlans dflags g + runUniqSM $ cmmImplementSwitchPlans (backend dflags) platform g dump Opt_D_dump_cmm_switch "Post switch plan" g ----------- Proc points ------------------------------------------------- @@ -97,7 +97,7 @@ cpsTop dflags proc = if splitting_proc_points then do pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $ - minimalProcPointSet (targetPlatform dflags) call_pps g + minimalProcPointSet platform call_pps g dumpWith dflags Opt_D_dump_cmm_proc "Proc points" FormatCMM (ppr l $$ ppr pp $$ ppr g) return pp @@ -114,7 +114,7 @@ cpsTop dflags proc = ----------- Sink and inline assignments -------------------------------- g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout] - condPass Opt_CmmSink (cmmSink dflags) g + condPass Opt_CmmSink (cmmSink platform) g Opt_D_dump_cmm_sink "Sink assignments" ------------- CAF analysis ---------------------------------------------- @@ -129,7 +129,7 @@ cpsTop dflags proc = dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" FormatCMM (ppr pp_map) g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ - splitAtProcPoints dflags l call_pps proc_points pp_map + splitAtProcPoints platform l call_pps proc_points pp_map (CmmProc h l v g) dumps Opt_D_dump_cmm_split "Post splitting" g return g @@ -355,7 +355,7 @@ dumpGraph dflags flag name g = do when (gopt Opt_DoCmmLinting dflags) $ do_lint g dumpWith dflags flag name FormatCMM (ppr g) where - do_lint g = case cmmLintGraph dflags g of + do_lint g = case cmmLintGraph (targetPlatform dflags) g of Just err -> do { fatalErrorMsg dflags err ; ghcExit dflags 1 } ===================================== compiler/GHC/Cmm/ProcPoint.hs ===================================== @@ -11,7 +11,6 @@ where import GHC.Prelude hiding (last, unzip, succ, zip) -import GHC.Driver.Session import GHC.Cmm.BlockId import GHC.Cmm.CLabel import GHC.Cmm @@ -238,9 +237,9 @@ extendPPSet platform g blocks procPoints = -- Input invariant: A block should only be reachable from a single ProcPoint. -- ToDo: use the _ret naming convention that the old code generator -- used. -- EZY -splitAtProcPoints :: DynFlags -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> +splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> CmmDecl -> UniqSM [CmmDecl] -splitAtProcPoints dflags entry_label callPPs procPoints procMap +splitAtProcPoints platform entry_label callPPs procPoints procMap (CmmProc (TopInfo {info_tbls = info_tbls}) top_l _ g@(CmmGraph {g_entry=entry})) = do -- Build a map from procpoints to the blocks they reach @@ -262,7 +261,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap where graph = mapLookup procId graphEnv `orElse` mapEmpty graph' = mapInsert bid b graph - let liveness = cmmGlobalLiveness dflags g + let liveness = cmmGlobalLiveness platform g let ppLiveness pp = filter isArgReg $ regSetToList $ expectJust "ppLiveness" $ mapLookup pp liveness @@ -316,7 +315,6 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap -- when jumping to a PP that has an info table, if -- tablesNextToCode is off we must jump to the entry -- label instead. - platform = targetPlatform dflags tablesNextToCode = platformTablesNextToCode platform jump_label (Just info_lbl) _ | tablesNextToCode = info_lbl ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -16,7 +16,6 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Driver.Session import GHC.Types.Unique import GHC.Types.Unique.FM @@ -165,10 +164,10 @@ type Assignments = [Assignment] -- y = e2 -- x = e1 -cmmSink :: DynFlags -> CmmGraph -> CmmGraph -cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks +cmmSink :: Platform -> CmmGraph -> CmmGraph +cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness dflags graph + liveness = cmmLocalLiveness platform graph getLive l = mapFindWithDefault Set.empty l liveness blocks = revPostorder graph @@ -181,7 +180,6 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- pprTrace "sink" (ppr lbl) $ blockJoin first final_middle final_last : sink sunk' bs where - platform = targetPlatform dflags lbl = entryLabel b (first, middle, last) = blockSplit b @@ -191,13 +189,13 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. live = Set.unions (map getLive succs) - live_middle = gen_kill dflags last live - ann_middles = annotate dflags live_middle (blockToList middle) + live_middle = gen_kill platform last live + ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block - (middle', assigs) = walk dflags ann_middles (mapFindWithDefault [] lbl sunk) + (middle', assigs) = walk platform ann_middles (mapFindWithDefault [] lbl sunk) fold_last = constantFoldNode platform last - (final_last, assigs') = tryToInline dflags live fold_last assigs + (final_last, assigs') = tryToInline platform live fold_last assigs -- We cannot sink into join points (successors with more than -- one predecessor), so identify the join points and the set @@ -217,12 +215,12 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks _ -> False -- Now, drop any assignments that we will not sink any further. - (dropped_last, assigs'') = dropAssignments dflags drop_if init_live_sets assigs' + (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where - should_drop = conflicts dflags a final_last - || not (isTrivial dflags rhs) && live_in_multi live_sets r + should_drop = conflicts platform a final_last + || not (isTrivial platform rhs) && live_in_multi live_sets r || r `Set.member` live_in_joins live_sets' | should_drop = live_sets @@ -231,12 +229,12 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks upd set | r `Set.member` set = set `Set.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed dflags extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last sunk' = mapUnion sunk $ - mapFromList [ (l, filterAssignments dflags (getLive l) assigs'') + mapFromList [ (l, filterAssignments platform (getLive l) assigs'') | l <- succs ] {- TODO: enable this later, when we have some good tests in place to @@ -255,12 +253,12 @@ isSmall _ = False -- We allow duplication of trivial expressions: registers (both local and -- global) and literals. -- -isTrivial :: DynFlags -> CmmExpr -> Bool +isTrivial :: Platform -> CmmExpr -> Bool isTrivial _ (CmmReg (CmmLocal _)) = True -isTrivial dflags (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?] - if isARM (platformArch (targetPlatform dflags)) +isTrivial platform (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?] + if isARM (platformArch platform) then True -- CodeGen.Platform.ARM does not have globalRegMaybe - else isJust (globalRegMaybe (targetPlatform dflags) r) + else isJust (globalRegMaybe platform r) -- GlobalRegs that are loads from BaseReg are not trivial isTrivial _ (CmmLit _) = True isTrivial _ _ = False @@ -268,9 +266,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: DynFlags -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] -annotate dflags live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill dflags n live, (live,n) : nodes) +annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate platform live nodes = snd $ foldr ann (live,[]) nodes + where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -287,14 +285,14 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: DynFlags -> LocalRegSet -> Assignments -> Assignments -filterAssignments dflags live assigs = reverse (go assigs []) +filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where needed = r `Set.member` live - || any (conflicts dflags a) (map toNode kept) + || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have -- already kept. @@ -313,7 +311,7 @@ filterAssignments dflags live assigs = reverse (go assigs []) -- * a list of assignments that will be placed *after* that block. -- -walk :: DynFlags +walk :: Platform -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -327,7 +325,7 @@ walk :: DynFlags , Assignments -- Assignments to sink further ) -walk dflags nodes assigs = go nodes emptyBlock assigs +walk platform nodes assigs = go nodes emptyBlock assigs where go [] block as = (block, as) go ((live,node):ns) block as @@ -336,13 +334,12 @@ walk dflags nodes assigs = go nodes emptyBlock assigs | Just a <- shouldSink platform node2 = go ns block (a : as1) | otherwise = go ns block' as' where - platform = targetPlatform dflags node1 = constantFoldNode platform node - (node2, as1) = tryToInline dflags live node1 as + (node2, as1) = tryToInline platform live node1 as - (dropped, as') = dropAssignmentsSimple dflags - (\a -> conflicts dflags a node2) as1 + (dropped, as') = dropAssignmentsSimple platform + (\a -> conflicts platform a node2) as1 block' = foldl' blockSnoc block dropped `blockSnoc` node2 @@ -380,13 +377,13 @@ shouldDiscard node live toNode :: Assignment -> CmmNode O O toNode (r,rhs,_) = CmmAssign (CmmLocal r) rhs -dropAssignmentsSimple :: DynFlags -> (Assignment -> Bool) -> Assignments +dropAssignmentsSimple :: Platform -> (Assignment -> Bool) -> Assignments -> ([CmmNode O O], Assignments) -dropAssignmentsSimple dflags f = dropAssignments dflags (\a _ -> (f a, ())) () +dropAssignmentsSimple platform f = dropAssignments platform (\a _ -> (f a, ())) () -dropAssignments :: DynFlags -> (Assignment -> s -> (Bool, s)) -> s -> Assignments +dropAssignments :: Platform -> (Assignment -> s -> (Bool, s)) -> s -> Assignments -> ([CmmNode O O], Assignments) -dropAssignments dflags should_drop state assigs +dropAssignments platform should_drop state assigs = (dropped, reverse kept) where (dropped,kept) = go state assigs [] [] @@ -397,7 +394,7 @@ dropAssignments dflags should_drop state assigs | otherwise = go state' rest dropped (assig:kept) where (dropit, state') = should_drop assig state - conflict = dropit || any (conflicts dflags assig) dropped + conflict = dropit || any (conflicts platform assig) dropped -- ----------------------------------------------------------------------------- @@ -406,7 +403,7 @@ dropAssignments dflags should_drop state assigs -- inlining opens up opportunities for doing so. tryToInline - :: DynFlags + :: Platform -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless @@ -418,10 +415,10 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline dflags live node assigs = go usages node emptyLRegSet assigs +tryToInline platform live node assigs = go usages node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used - usages = foldLocalRegsUsed dflags addUsage emptyUFM node + usages = foldLocalRegsUsed platform addUsage emptyUFM node go _usages node _skipped [] = (node, []) @@ -429,12 +426,11 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs | cannot_inline = dont_inline | occurs_none = discard -- Note [discard during inlining] | occurs_once = inline_and_discard - | isTrivial dflags rhs = inline_and_keep + | isTrivial platform rhs = inline_and_keep | otherwise = dont_inline where - platform = targetPlatform dflags inline_and_discard = go usages' inl_node skipped rest - where usages' = foldLocalRegsUsed dflags addUsage usages rhs + where usages' = foldLocalRegsUsed platform addUsage usages rhs discard = go usages node skipped rest @@ -443,7 +439,7 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs keep node' = (final_node, a : rest') where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest - usages' = foldLocalRegsUsed dflags (\m r -> addToUFM m r 2) + usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) usages rhs -- we must not inline anything that is mentioned in the RHS -- of a binding that we have already skipped, so we set the @@ -451,7 +447,7 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped - || not (okToInline dflags rhs node) + || not (okToInline platform rhs node) l_usages = lookupUFM usages l l_live = l `elemRegSet` live @@ -569,25 +565,25 @@ regsUsedIn ls e = wrapRecExpf f e False -- ought to be able to handle it properly, but currently neither PprC -- nor the NCG can do it. See Note [Register parameter passing] -- See also GHC.StgToCmm.Foreign.load_args_into_temps. -okToInline :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -okToInline dflags expr node@(CmmUnsafeForeignCall{}) = - not (globalRegistersConflict dflags expr node) +okToInline :: Platform -> CmmExpr -> CmmNode e x -> Bool +okToInline platform expr node@(CmmUnsafeForeignCall{}) = + not (globalRegistersConflict platform expr node) okToInline _ _ _ = True -- ----------------------------------------------------------------------------- -- | @conflicts (r,e) node@ is @False@ if and only if the assignment -- @r = e@ can be safely commuted past statement @node at . -conflicts :: DynFlags -> Assignment -> CmmNode O x -> Bool -conflicts dflags (r, rhs, addr) node +conflicts :: Platform -> Assignment -> CmmNode O x -> Bool +conflicts platform (r, rhs, addr) node -- (1) node defines registers used by rhs of assignment. This catches -- assignments and all three kinds of calls. See Note [Sinking and calls] - | globalRegistersConflict dflags rhs node = True - | localRegistersConflict dflags rhs node = True + | globalRegistersConflict platform rhs node = True + | localRegistersConflict platform rhs node = True -- (2) node uses register defined by assignment - | foldRegsUsed dflags (\b r' -> r == r' || b) False node = True + | foldRegsUsed platform (\b r' -> r == r' || b) False node = True -- (3) a store to an address conflicts with a read of the same memory | CmmStore addr' e <- node @@ -606,21 +602,19 @@ conflicts dflags (r, rhs, addr) node -- (7) otherwise, no conflict | otherwise = False - where - platform = targetPlatform dflags -- Returns True if node defines any global registers that are used in the -- Cmm expression -globalRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -globalRegistersConflict dflags expr node = - foldRegsDefd dflags (\b r -> b || regUsedIn (targetPlatform dflags) (CmmGlobal r) expr) +globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool +globalRegistersConflict platform expr node = + foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) False node -- Returns True if node defines any local registers that are used in the -- Cmm expression -localRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -localRegistersConflict dflags expr node = - foldRegsDefd dflags (\b r -> b || regUsedIn (targetPlatform dflags) (CmmLocal r) expr) +localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool +localRegistersConflict platform expr node = + foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) False node -- Note [Sinking and calls] ===================================== compiler/GHC/Cmm/Switch/Implement.hs ===================================== @@ -6,6 +6,7 @@ where import GHC.Prelude +import GHC.Driver.Backend import GHC.Platform import GHC.Cmm.Dataflow.Block import GHC.Cmm.BlockId @@ -13,7 +14,6 @@ import GHC.Cmm import GHC.Cmm.Utils import GHC.Cmm.Switch import GHC.Types.Unique.Supply -import GHC.Driver.Session import GHC.Utils.Monad (concatMapM) -- @@ -32,12 +32,12 @@ import GHC.Utils.Monad (concatMapM) -- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for -- code generation. -cmmImplementSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph -cmmImplementSwitchPlans dflags g +cmmImplementSwitchPlans :: Backend -> Platform -> CmmGraph -> UniqSM CmmGraph +cmmImplementSwitchPlans backend platform g -- Switch generation done by backend (LLVM/C) - | backendSupportsSwitch (backend dflags) = return g + | backendSupportsSwitch backend = return g | otherwise = do - blocks' <- concatMapM (visitSwitches (targetPlatform dflags)) (toBlockList g) + blocks' <- concatMapM (visitSwitches platform) (toBlockList g) return $ ofBlockList (g_entry g) blocks' visitSwitches :: Platform -> CmmBlock -> UniqSM [CmmBlock] ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -91,7 +91,7 @@ pprTop platform = \case blankLine, extern_decls, (if (externallyVisibleCLabel clbl) - then mkFN_ else mkIF_) (ppr clbl) <+> lbrace, + then mkFN_ else mkIF_) (pprCLabel_ViaC platform clbl) <+> lbrace, nest 8 temp_decls, vcat (map (pprBBlock platform) blocks), rbrace ] @@ -110,14 +110,14 @@ pprTop platform = \case (CmmData section (CmmStaticsRaw lbl [CmmString str])) -> pprExternDecl platform lbl $$ hcat [ - pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl, text "[] = ", pprStringInCStyle str, semi ] (CmmData section (CmmStaticsRaw lbl [CmmUninitialised size])) -> pprExternDecl platform lbl $$ hcat [ - pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl, brackets (int size), semi ] @@ -153,7 +153,7 @@ pprWordArray platform is_ro lbl ds = -- TODO: align closures only pprExternDecl platform lbl $$ hcat [ pprLocalness lbl, pprConstness is_ro, text "StgWord" - , space, ppr lbl, text "[]" + , space, pprCLabel_ViaC platform lbl, text "[]" -- See Note [StgWord alignment] , pprAlignment (wordWidth platform) , text "= {" ] @@ -238,7 +238,7 @@ pprStmt platform stmt = case fn of CmmLit (CmmLabel lbl) | StdCallConv <- cconv -> - pprCall platform (ppr lbl) cconv hresults hargs + pprCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs -- stdcall functions must be declared with -- a function type, otherwise the C compiler -- doesn't add the @n suffix to the label. We @@ -247,7 +247,7 @@ pprStmt platform stmt = | CmmNeverReturns <- ret -> pprCall platform cast_fn cconv hresults hargs <> semi | not (isMathFun lbl) -> - pprForeignCall platform (ppr lbl) cconv hresults hargs + pprForeignCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs _ -> pprCall platform cast_fn cconv hresults hargs <> semi -- for a dynamic call, no declaration is necessary. @@ -487,7 +487,7 @@ pprLit platform lit = case lit of -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i where - pprCLabelAddr lbl = char '&' <> ppr lbl + pprCLabelAddr lbl = char '&' <> pprCLabel_ViaC platform lbl pprLit1 :: Platform -> CmmLit -> SDoc pprLit1 platform lit = case lit of @@ -1047,7 +1047,7 @@ pprExternDecl platform lbl | not (needsCDecl lbl) = empty | Just sz <- foreignLabelStdcallInfo lbl = stdcall_decl sz | otherwise = - hcat [ visibility, label_type lbl , lparen, ppr lbl, text ");" + hcat [ visibility, label_type lbl , lparen, pprCLabel_ViaC platform lbl, text ");" -- occasionally useful to see label type -- , text "/* ", pprDebugCLabel lbl, text " */" ] @@ -1070,7 +1070,7 @@ pprExternDecl platform lbl -- we must generate an appropriate prototype for it, so that the C compiler will -- add the @n suffix to the label (#2276) stdcall_decl sz = - text "extern __attribute__((stdcall)) void " <> ppr lbl + text "extern __attribute__((stdcall)) void " <> pprCLabel_ViaC platform lbl <> parens (commafy (replicate (sz `quot` platformWordSizeInBytes platform) (machRep_U_CType platform (wordWidth platform)))) <> semi ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -51,8 +51,9 @@ module GHC.Core.DataCon ( splitDataProductType_maybe, -- ** Predicates on DataCons - isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon, - isUnboxedSumCon, + isNullarySrcDataCon, isNullaryRepDataCon, + isTupleDataCon, isBoxedTupleDataCon, isUnboxedTupleDataCon, + isUnboxedSumDataCon, isVanillaDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsArePermuted, isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked, @@ -1467,11 +1468,14 @@ dataConIdentity dc = LBS.toStrict $ BSB.toLazyByteString $ mconcat isTupleDataCon :: DataCon -> Bool isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc -isUnboxedTupleCon :: DataCon -> Bool -isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc +isBoxedTupleDataCon :: DataCon -> Bool +isBoxedTupleDataCon (MkData {dcRepTyCon = tc}) = isBoxedTupleTyCon tc -isUnboxedSumCon :: DataCon -> Bool -isUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc +isUnboxedTupleDataCon :: DataCon -> Bool +isUnboxedTupleDataCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc + +isUnboxedSumDataCon :: DataCon -> Bool +isUnboxedSumDataCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc -- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors isVanillaDataCon :: DataCon -> Bool ===================================== compiler/GHC/Core/DataCon.hs-boot ===================================== @@ -26,7 +26,7 @@ dataConInstOrigArgTys :: DataCon -> [Type] -> [Scaled Type] dataConStupidTheta :: DataCon -> ThetaType dataConFullSig :: DataCon -> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Scaled Type], Type) -isUnboxedSumCon :: DataCon -> Bool +isUnboxedSumDataCon :: DataCon -> Bool instance Eq DataCon instance Uniquable DataCon ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -359,7 +359,7 @@ forcesRealWorld fam_envs ty = True | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } <- deepSplitProductType_maybe fam_envs ty - , isUnboxedTupleCon dc + , isUnboxedTupleDataCon dc = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys | otherwise = False ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Core.Coercion.Opt ( optCoercion ) import GHC.Core.FamInstEnv ( topNormaliseType_maybe ) import GHC.Core.DataCon ( DataCon, dataConWorkId, dataConRepStrictness - , dataConRepArgTys, isUnboxedTupleCon + , dataConRepArgTys, isUnboxedTupleDataCon , StrictnessMark (..) ) import GHC.Core.Opt.Monad ( Tick(..), SimplMode(..) ) import GHC.Core @@ -2957,7 +2957,7 @@ addEvals :: Maybe OutExpr -> DataCon -> [Id] -> [Id] addEvals scrut con vs -- Deal with seq# applications | Just scr <- scrut - , isUnboxedTupleCon con + , isUnboxedTupleDataCon con , [s,x] <- vs -- Use stripNArgs rather than collectArgsTicks to avoid building -- a list of arguments only to throw it away immediately. ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -148,7 +148,7 @@ import {-# SOURCE #-} GHC.Builtin.Types import {-# SOURCE #-} GHC.Core.DataCon ( DataCon, dataConExTyCoVars, dataConFieldLabels , dataConTyCon, dataConFullSig - , isUnboxedSumCon ) + , isUnboxedSumDataCon ) import GHC.Builtin.Uniques ( tyConRepNameUnique , dataConTyRepNameUnique ) @@ -1323,7 +1323,7 @@ tyConRepName_maybe (AlgTyCon { algTcParent = parent }) tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm }) = Just rep_nm tyConRepName_maybe (PromotedDataCon { dataCon = dc, tcRepName = rep_nm }) - | isUnboxedSumCon dc -- see #13276 + | isUnboxedSumDataCon dc -- see #13276 = Nothing | otherwise = Just rep_nm ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -889,7 +889,7 @@ conSize dc n_val_args | n_val_args == 0 = SizeIs 0 emptyBag 10 -- Like variables -- See Note [Unboxed tuple size and result discount] - | isUnboxedTupleCon dc = SizeIs 0 emptyBag 10 + | isUnboxedTupleDataCon dc = SizeIs 0 emptyBag 10 -- See Note [Constructor size and result discount] | otherwise = SizeIs 10 emptyBag 10 ===================================== compiler/GHC/CoreToByteCode.hs ===================================== @@ -648,7 +648,7 @@ schemeE d s p (AnnCase (_,scrut) _ _ []) = schemeE d s p scrut -- handle pairs with one void argument (e.g. state token) schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)]) - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc -- Convert -- case .... of x { (# V'd-thing, a #) -> ... } -- to @@ -667,7 +667,7 @@ schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)]) -- handle unit tuples schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)]) - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc , typePrimRep (idType bndr) `lengthAtMost` 1 = doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr) @@ -825,7 +825,7 @@ schemeT d s p app -- Case 2: Constructor application | Just con <- maybe_saturated_dcon - , isUnboxedTupleCon con + , isUnboxedTupleDataCon con = case args_r_to_l of [arg1,arg2] | isVAtom arg1 -> unboxedTupleReturn d s p arg2 @@ -1090,7 +1090,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} my_discr (DataAlt dc, _, _) - | isUnboxedTupleCon dc || isUnboxedSumCon dc + | isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc = multiValException | otherwise = DiscrP (fromIntegral (dataConTag dc - fIRST_TAG)) ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -188,7 +188,7 @@ toIfaceTypeX fr (TyConApp tc tys) = IfaceTupleTy sort NotPromoted (toIfaceTcArgsX fr tc tys) | Just dc <- isPromotedDataCon_maybe tc - , isTupleDataCon dc + , isBoxedTupleDataCon dc , n_tys == 2*arity = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys)) ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -699,7 +699,7 @@ mkTopStgRhs dflags this_mod ccs bndr rhs , -- Dynamic StgConApps are updatable not (isDllConApp dflags this_mod con args) = -- CorePrep does this right, but just to make sure - ASSERT2( not (isUnboxedTupleCon con || isUnboxedSumCon con) + ASSERT2( not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) , ppr bndr $$ ppr con $$ ppr args) ( StgRhsCon dontCareCCS con args, ccs ) ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -83,7 +83,7 @@ codeOutput dflags this_mod filenm location foreign_stubs foreign_fps pkg_deps dflags (text "CmmLint"<+>brackets (ppr this_mod)) (const ()) $ do - { case cmmLint dflags cmm of + { case cmmLint (targetPlatform dflags) cmm of Just err -> do { log_action dflags dflags NoReason ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -172,7 +172,7 @@ pprConLike delta _prec cl args WcVarTerminated pref x -> parens . fcat . punctuate colon <$> mapM (pprPmVar appPrec) (toList pref ++ [x]) pprConLike _delta _prec (RealDataCon con) args - | isUnboxedTupleCon con + | isUnboxedTupleDataCon con , let hash_parens doc = text "(#" <+> doc <+> text "#)" = hash_parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args | isTupleDataCon con ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -164,7 +164,7 @@ lintStgRhs (StgRhsClosure _ _ _ binders expr) lintStgExpr expr lintStgRhs rhs@(StgRhsCon _ con args) = do - when (isUnboxedTupleCon con || isUnboxedSumCon con) $ do + when (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) $ do opts <- getStgPprOpts addErrL (text "StgRhsCon is an unboxed tuple or sum application" $$ pprStgRhs opts rhs) @@ -182,7 +182,7 @@ lintStgExpr (StgApp fun args) = do lintStgExpr app@(StgConApp con args _arg_tys) = do -- unboxed sums should vanish during unarise lf <- getLintFlags - when (lf_unarised lf && isUnboxedSumCon con) $ do + when (lf_unarised lf && isUnboxedSumDataCon con) $ do opts <- getStgPprOpts addErrL (text "Unboxed sum after unarise:" $$ pprStgExpr opts app) ===================================== compiler/GHC/Stg/Unarise.hs ===================================== @@ -294,7 +294,7 @@ unariseRhs rho (StgRhsClosure ext ccs update_flag args expr) return (StgRhsClosure ext ccs update_flag args1 expr') unariseRhs rho (StgRhsCon ccs con args) - = ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con)) + = ASSERT(not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con)) return (StgRhsCon ccs con (unariseConArgs rho args)) -------------------------------------------------------------------------------- @@ -372,10 +372,10 @@ unariseExpr rho (StgTick tick e) -- Doesn't return void args. unariseMulti_maybe :: UnariseEnv -> DataCon -> [InStgArg] -> [Type] -> Maybe [OutStgArg] unariseMulti_maybe rho dc args ty_args - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc = Just (unariseConArgs rho args) - | isUnboxedSumCon dc + | isUnboxedSumDataCon dc , let args1 = ASSERT(isSingleton args) (unariseConArgs rho args) = Just (mkUbxSum dc ty_args args1) ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -354,7 +354,7 @@ bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg] -- binders args, assuming that we have just returned from a 'case' which -- found a con bindConArgs (DataAlt con) base args - = ASSERT(not (isUnboxedTupleCon con)) + = ASSERT(not (isUnboxedTupleDataCon con)) do profile <- getProfile platform <- getPlatform let (_, _, args_w_offsets) = mkVirtConstrOffsets profile (addIdReps args) ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -837,7 +837,7 @@ maybeAltHeapCheck (GcInAlts regs, ReturnedTo lret off) code = cgConApp :: DataCon -> [StgArg] -> FCode ReturnKind cgConApp con stg_args - | isUnboxedTupleCon con -- Unboxed tuple: assign and return + | isUnboxedTupleDataCon con -- Unboxed tuple: assign and return = do { arg_exprs <- getNonVoidArgAmodes stg_args ; tickyUnboxedTupleReturn (length arg_exprs) ; emitReturn arg_exprs } ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -556,7 +556,7 @@ hasNoBinding :: Id -> Bool hasNoBinding id = case Var.idDetails id of PrimOpId _ -> True -- See Note [Eta expanding primops] in GHC.Builtin.PrimOps FCallId _ -> True - DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc + DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc _ -> isCompulsoryUnfolding (idUnfolding id) -- See Note [Levity-polymorphic Ids] ===================================== testsuite/tests/ghci/scripts/T18644.script ===================================== @@ -0,0 +1,3 @@ +:set -XDataKinds -XUnboxedTuples +:kind! '(# #) +:kind! '() ===================================== testsuite/tests/ghci/scripts/T18644.stdout ===================================== @@ -0,0 +1,4 @@ +'(# #) :: (# #) += '(# #) +'() :: () += '() ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -315,3 +315,4 @@ test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script']) +test('T18644', normal, ghci_script, ['T18644.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff8a6dead9e72d684d906346504ca0de30fa473a...d54d95bc32bbd8f2ffc36a328a09838491bd6690 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff8a6dead9e72d684d906346504ca0de30fa473a...d54d95bc32bbd8f2ffc36a328a09838491bd6690 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 14:34:22 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Sep 2020 10:34:22 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Don't rely on CLabel's Outputable instance in CmmToC Message-ID: <5f52506ee303b_80b3f849644a05c105949f5@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: df95a9a1 by Sylvain Henry at 2020-09-04T10:34:06-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - fdd89c8f by Sylvain Henry at 2020-09-04T10:34:08-04:00 DynFlags: use Platform in foldRegs* - - - - - f3e27e4d by Sylvain Henry at 2020-09-04T10:34:08-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - 67076e23 by Ryan Scott at 2020-09-04T10:34:08-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 30 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Types/Id.hs - + testsuite/tests/ghci/scripts/T18644.script - + testsuite/tests/ghci/scripts/T18644.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -108,7 +108,7 @@ module GHC.Cmm.CLabel ( -- * Conversions toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName, - pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, + pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, pprCLabel_ViaC, isInfoTableLabel, isConInfoTableLabel, isIdLabel, isTickyLabel @@ -1218,11 +1218,15 @@ pprCLabel bcknd platform lbl = case bcknd of NCG -> pprCLabel_NCG platform lbl LLVM -> pprCLabel_LLVM platform lbl + ViaC -> pprCLabel_ViaC platform lbl _ -> pprCLabel_other platform lbl pprCLabel_LLVM :: Platform -> CLabel -> SDoc pprCLabel_LLVM = pprCLabel_NCG +pprCLabel_ViaC :: Platform -> CLabel -> SDoc +pprCLabel_ViaC = pprCLabel_other + pprCLabel_NCG :: Platform -> CLabel -> SDoc pprCLabel_NCG platform lbl = getPprStyle $ \sty -> let @@ -1348,7 +1352,13 @@ pprCLabel_common platform = \case (ForeignLabel str _ _ _) -> ftext str - (IdLabel name _cafs flavor) -> internalNamePrefix platform name <> ppr name <> ppIdFlavor flavor + (IdLabel name _cafs flavor) -> internalNamePrefix <> ppr name <> ppIdFlavor flavor + where + isRandomGenerated = not (isExternalName name) + internalNamePrefix = getPprStyle $ \ sty -> + if asmStyle sty && isRandomGenerated + then ptext (asmTempLabelPrefix platform) + else empty (CC_Label cc) -> ppr cc (CCS_Label ccs) -> ppr ccs @@ -1389,15 +1399,6 @@ instance Outputable ForeignLabelSource where ForeignLabelInThisPackage -> parens $ text "this package" ForeignLabelInExternalPackage -> parens $ text "external package" -internalNamePrefix :: Platform -> Name -> SDoc -internalNamePrefix platform name = getPprStyle $ \ sty -> - if asmStyle sty && isRandomGenerated then - ptext (asmTempLabelPrefix platform) - else - empty - where - isRandomGenerated = not $ isExternalName name - tempLabelPrefixOrUnderscore :: Platform -> SDoc tempLabelPrefixOrUnderscore platform = getPprStyle $ \ sty -> ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -38,7 +38,6 @@ import GHC.Cmm.BlockId import GHC.Cmm.CLabel import GHC.Cmm.MachOp import GHC.Cmm.Type -import GHC.Driver.Session import GHC.Utils.Panic (panic) import GHC.Types.Unique @@ -331,17 +330,17 @@ sizeRegSet = Set.size regSetToList = Set.toList class Ord r => UserOfRegs r a where - foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b + foldRegsUsed :: Platform -> (b -> r -> b) -> b -> a -> b foldLocalRegsUsed :: UserOfRegs LocalReg a - => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b + => Platform -> (b -> LocalReg -> b) -> b -> a -> b foldLocalRegsUsed = foldRegsUsed class Ord r => DefinerOfRegs r a where - foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b + foldRegsDefd :: Platform -> (b -> r -> b) -> b -> a -> b foldLocalRegsDefd :: DefinerOfRegs LocalReg a - => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b + => Platform -> (b -> LocalReg -> b) -> b -> a -> b foldLocalRegsDefd = foldRegsDefd instance UserOfRegs LocalReg CmmReg where @@ -369,20 +368,20 @@ instance Ord r => DefinerOfRegs r r where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance - foldRegsUsed dflags f !z e = expr z e + foldRegsUsed platform f !z e = expr z e where expr z (CmmLit _) = z - expr z (CmmLoad addr _) = foldRegsUsed dflags f z addr - expr z (CmmReg r) = foldRegsUsed dflags f z r - expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs - expr z (CmmRegOff r _) = foldRegsUsed dflags f z r + expr z (CmmLoad addr _) = foldRegsUsed platform f z addr + expr z (CmmReg r) = foldRegsUsed platform f z r + expr z (CmmMachOp _ exprs) = foldRegsUsed platform f z exprs + expr z (CmmRegOff r _) = foldRegsUsed platform f z r expr z (CmmStackSlot _ _) = z instance UserOfRegs r a => UserOfRegs r [a] where - foldRegsUsed dflags f set as = foldl' (foldRegsUsed dflags f) set as + foldRegsUsed platform f set as = foldl' (foldRegsUsed platform f) set as {-# INLINABLE foldRegsUsed #-} instance DefinerOfRegs r a => DefinerOfRegs r [a] where - foldRegsDefd dflags f set as = foldl' (foldRegsDefd dflags f) set as + foldRegsDefd platform f set as = foldl' (foldRegsDefd platform f) set as {-# INLINABLE foldRegsDefd #-} ----------------------------------------------------------------------------- ===================================== compiler/GHC/Cmm/LayoutStack.hs ===================================== @@ -246,9 +246,10 @@ cmmLayoutStack dflags procpoints entry_args = do -- We need liveness info. Dead assignments are removed later -- by the sinking pass. - let liveness = cmmLocalLiveness dflags graph + let liveness = cmmLocalLiveness platform graph blocks = revPostorder graph - profile = targetProfile dflags + profile = targetProfile dflags + platform = profilePlatform profile (final_stackmaps, _final_high_sp, new_blocks) <- mfix $ \ ~(rec_stackmaps, rec_high_sp, _new_blocks) -> @@ -256,7 +257,7 @@ cmmLayoutStack dflags procpoints entry_args rec_stackmaps rec_high_sp blocks blocks_with_reloads <- - insertReloadsAsNeeded dflags procpoints final_stackmaps entry new_blocks + insertReloadsAsNeeded platform procpoints final_stackmaps entry new_blocks new_blocks' <- mapM (lowerSafeForeignCall profile) blocks_with_reloads return (ofBlockList entry new_blocks', final_stackmaps) @@ -1044,30 +1045,29 @@ stackMapToLiveness platform StackMap{..} = -- ----------------------------------------------------------------------------- insertReloadsAsNeeded - :: DynFlags + :: Platform -> ProcPointSet -> LabelMap StackMap -> BlockId -> [CmmBlock] -> UniqSM [CmmBlock] -insertReloadsAsNeeded dflags procpoints final_stackmaps entry blocks = do +insertReloadsAsNeeded platform procpoints final_stackmaps entry blocks = do toBlockList . fst <$> rewriteCmmBwd liveLattice rewriteCC (ofBlockList entry blocks) mapEmpty where rewriteCC :: RewriteFun CmmLocalLive rewriteCC (BlockCC e_node middle0 x_node) fact_base0 = do let entry_label = entryLabel e_node - platform = targetPlatform dflags stackmap = case mapLookup entry_label final_stackmaps of Just sm -> sm Nothing -> panic "insertReloadsAsNeeded: rewriteCC: stackmap" -- Merge the liveness from successor blocks and analyse the last -- node. - joined = gen_kill dflags x_node $! + joined = gen_kill platform x_node $! joinOutFacts liveLattice x_node fact_base0 -- What is live at the start of middle0. - live_at_middle0 = foldNodesBwdOO (gen_kill dflags) middle0 joined + live_at_middle0 = foldNodesBwdOO (gen_kill platform) middle0 joined -- If this is a procpoint we need to add the reloads, but only if -- they're actually live. Furthermore, nothing is live at the entry ===================================== compiler/GHC/Cmm/Lint.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Cmm.Liveness import GHC.Cmm.Switch (switchTargetsToList) import GHC.Cmm.Ppr () -- For Outputable instances import GHC.Utils.Outputable -import GHC.Driver.Session import Control.Monad (ap, unless) @@ -39,37 +38,38 @@ import Control.Monad (ap, unless) -- Exported entry points: cmmLint :: (Outputable d, Outputable h) - => DynFlags -> GenCmmGroup d h CmmGraph -> Maybe SDoc -cmmLint dflags tops = runCmmLint dflags (mapM_ (lintCmmDecl dflags)) tops + => Platform -> GenCmmGroup d h CmmGraph -> Maybe SDoc +cmmLint platform tops = runCmmLint platform (mapM_ lintCmmDecl) tops -cmmLintGraph :: DynFlags -> CmmGraph -> Maybe SDoc -cmmLintGraph dflags g = runCmmLint dflags (lintCmmGraph dflags) g +cmmLintGraph :: Platform -> CmmGraph -> Maybe SDoc +cmmLintGraph platform g = runCmmLint platform lintCmmGraph g -runCmmLint :: Outputable a => DynFlags -> (a -> CmmLint b) -> a -> Maybe SDoc -runCmmLint dflags l p = - case unCL (l p) dflags of +runCmmLint :: Outputable a => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc +runCmmLint platform l p = + case unCL (l p) platform of Left err -> Just (vcat [text "Cmm lint error:", nest 2 err, text "Program was:", nest 2 (ppr p)]) Right _ -> Nothing -lintCmmDecl :: DynFlags -> GenCmmDecl h i CmmGraph -> CmmLint () -lintCmmDecl dflags (CmmProc _ lbl _ g) - = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph dflags g -lintCmmDecl _ (CmmData {}) +lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint () +lintCmmDecl (CmmProc _ lbl _ g) + = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph g +lintCmmDecl (CmmData {}) = return () -lintCmmGraph :: DynFlags -> CmmGraph -> CmmLint () -lintCmmGraph dflags g = - cmmLocalLiveness dflags g `seq` mapM_ (lintCmmBlock labels) blocks - -- cmmLiveness throws an error if there are registers - -- live on entry to the graph (i.e. undefined - -- variables) - where - blocks = toBlockList g - labels = setFromList (map entryLabel blocks) +lintCmmGraph :: CmmGraph -> CmmLint () +lintCmmGraph g = do + platform <- getPlatform + let + blocks = toBlockList g + labels = setFromList (map entryLabel blocks) + cmmLocalLiveness platform g `seq` mapM_ (lintCmmBlock labels) blocks + -- cmmLiveness throws an error if there are registers + -- live on entry to the graph (i.e. undefined + -- variables) lintCmmBlock :: LabelSet -> CmmBlock -> CmmLint () @@ -225,9 +225,9 @@ lintTarget (PrimTarget {}) = return () mayNotMentionCallerSavedRegs :: (UserOfRegs GlobalReg a, Outputable a) => SDoc -> a -> CmmLint () mayNotMentionCallerSavedRegs what thing = do - dflags <- getDynFlags - let badRegs = filter (callerSaves (targetPlatform dflags)) - $ foldRegsUsed dflags (flip (:)) [] thing + platform <- getPlatform + let badRegs = filter (callerSaves platform) + $ foldRegsUsed platform (flip (:)) [] thing unless (null badRegs) $ cmmLintErr (what <+> text "mentions caller-saved registers: " <> ppr badRegs $$ ppr thing) @@ -243,7 +243,7 @@ checkCond _ expr -- just a basic error monad: -newtype CmmLint a = CmmLint { unCL :: DynFlags -> Either SDoc a } +newtype CmmLint a = CmmLint { unCL :: Platform -> Either SDoc a } deriving (Functor) instance Applicative CmmLint where @@ -251,23 +251,20 @@ instance Applicative CmmLint where (<*>) = ap instance Monad CmmLint where - CmmLint m >>= k = CmmLint $ \dflags -> - case m dflags of + CmmLint m >>= k = CmmLint $ \platform -> + case m platform of Left e -> Left e - Right a -> unCL (k a) dflags - -instance HasDynFlags CmmLint where - getDynFlags = CmmLint (\dflags -> Right dflags) + Right a -> unCL (k a) platform getPlatform :: CmmLint Platform -getPlatform = targetPlatform <$> getDynFlags +getPlatform = CmmLint $ \platform -> Right platform cmmLintErr :: SDoc -> CmmLint a cmmLintErr msg = CmmLint (\_ -> Left msg) addLintInfo :: SDoc -> CmmLint a -> CmmLint a -addLintInfo info thing = CmmLint $ \dflags -> - case unCL thing dflags of +addLintInfo info thing = CmmLint $ \platform -> + case unCL thing platform of Left err -> Left (hang info 2 err) Right a -> Right a ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -14,7 +14,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Platform import GHC.Cmm.BlockId import GHC.Cmm import GHC.Cmm.Ppr.Expr () -- For Outputable instances @@ -52,17 +52,17 @@ type BlockEntryLiveness r = LabelMap (CmmLive r) -- | Calculated liveness info for a CmmGraph ----------------------------------------------------------------------------- -cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg -cmmLocalLiveness dflags graph = - check $ analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty +cmmLocalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg +cmmLocalLiveness platform graph = + check $ analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty where entry = g_entry graph check facts = noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts -cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg -cmmGlobalLiveness dflags graph = - analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty +cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalReg +cmmGlobalLiveness platform graph = + analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty -- | On entry to the procedure, there had better not be any LocalReg's live-in. noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a @@ -72,10 +72,10 @@ noLiveOnEntry bid in_fact x = gen_kill :: (DefinerOfRegs r n, UserOfRegs r n) - => DynFlags -> n -> CmmLive r -> CmmLive r -gen_kill dflags node set = - let !afterKill = foldRegsDefd dflags deleteFromRegSet set node - in foldRegsUsed dflags extendRegSet afterKill node + => Platform -> n -> CmmLive r -> CmmLive r +gen_kill platform node set = + let !afterKill = foldRegsDefd platform deleteFromRegSet set node + in foldRegsUsed platform extendRegSet afterKill node {-# INLINE gen_kill #-} xferLive @@ -85,10 +85,10 @@ xferLive , UserOfRegs r (CmmNode O C) , DefinerOfRegs r (CmmNode O C) ) - => DynFlags -> TransferFun (CmmLive r) -xferLive dflags (BlockCC eNode middle xNode) fBase = - let joined = gen_kill dflags xNode $! joinOutFacts liveLattice xNode fBase - !result = foldNodesBwdOO (gen_kill dflags) middle joined + => Platform -> TransferFun (CmmLive r) +xferLive platform (BlockCC eNode middle xNode) fBase = + let joined = gen_kill platform xNode $! joinOutFacts liveLattice xNode fBase + !result = foldNodesBwdOO (gen_kill platform) middle joined in mapSingleton (entryLabel eNode) result -{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-} -{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-} +{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} +{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -31,7 +31,6 @@ import GHC.Prelude hiding (succ) import GHC.Platform.Regs import GHC.Cmm.Expr import GHC.Cmm.Switch -import GHC.Driver.Session import GHC.Data.FastString import GHC.Types.ForeignCall import GHC.Utils.Outputable @@ -320,7 +319,7 @@ foreignTargetHints target -- Instances of register and slot users / definers instance UserOfRegs LocalReg (CmmNode e x) where - foldRegsUsed dflags f !z n = case n of + foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args @@ -331,10 +330,10 @@ instance UserOfRegs LocalReg (CmmNode e x) where _ -> z where fold :: forall a b. UserOfRegs LocalReg a => (b -> LocalReg -> b) -> b -> a -> b - fold f z n = foldRegsUsed dflags f z n + fold f z n = foldRegsUsed platform f z n instance UserOfRegs GlobalReg (CmmNode e x) where - foldRegsUsed dflags f !z n = case n of + foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args @@ -345,26 +344,26 @@ instance UserOfRegs GlobalReg (CmmNode e x) where _ -> z where fold :: forall a b. UserOfRegs GlobalReg a => (b -> GlobalReg -> b) -> b -> a -> b - fold f z n = foldRegsUsed dflags f z n + fold f z n = foldRegsUsed platform f z n instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance - foldRegsUsed _ _ !z (PrimTarget _) = z - foldRegsUsed dflags f !z (ForeignTarget e _) = foldRegsUsed dflags f z e + foldRegsUsed _ _ !z (PrimTarget _) = z + foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e instance DefinerOfRegs LocalReg (CmmNode e x) where - foldRegsDefd dflags f !z n = case n of + foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall _ fs _ -> fold f z fs CmmForeignCall {res=res} -> fold f z res _ -> z where fold :: forall a b. DefinerOfRegs LocalReg a => (b -> LocalReg -> b) -> b -> a -> b - fold f z n = foldRegsDefd dflags f z n + fold f z n = foldRegsDefd platform f z n instance DefinerOfRegs GlobalReg (CmmNode e x) where - foldRegsDefd dflags f !z n = case n of + foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt) CmmCall {} -> fold f z activeRegs @@ -373,9 +372,8 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where _ -> z where fold :: forall a b. DefinerOfRegs GlobalReg a => (b -> GlobalReg -> b) -> b -> a -> b - fold f z n = foldRegsDefd dflags f z n + fold f z n = foldRegsDefd platform f z n - platform = targetPlatform dflags activeRegs = activeStgRegs platform activeCallerSavesRegs = filter (callerSaves platform) activeRegs ===================================== compiler/GHC/Cmm/Pipeline.hs ===================================== @@ -86,7 +86,7 @@ cpsTop dflags proc = ----------- Implement switches ------------------------------------------ g <- {-# SCC "createSwitchPlans" #-} - runUniqSM $ cmmImplementSwitchPlans dflags g + runUniqSM $ cmmImplementSwitchPlans (backend dflags) platform g dump Opt_D_dump_cmm_switch "Post switch plan" g ----------- Proc points ------------------------------------------------- @@ -97,7 +97,7 @@ cpsTop dflags proc = if splitting_proc_points then do pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $ - minimalProcPointSet (targetPlatform dflags) call_pps g + minimalProcPointSet platform call_pps g dumpWith dflags Opt_D_dump_cmm_proc "Proc points" FormatCMM (ppr l $$ ppr pp $$ ppr g) return pp @@ -114,7 +114,7 @@ cpsTop dflags proc = ----------- Sink and inline assignments -------------------------------- g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout] - condPass Opt_CmmSink (cmmSink dflags) g + condPass Opt_CmmSink (cmmSink platform) g Opt_D_dump_cmm_sink "Sink assignments" ------------- CAF analysis ---------------------------------------------- @@ -129,7 +129,7 @@ cpsTop dflags proc = dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" FormatCMM (ppr pp_map) g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ - splitAtProcPoints dflags l call_pps proc_points pp_map + splitAtProcPoints platform l call_pps proc_points pp_map (CmmProc h l v g) dumps Opt_D_dump_cmm_split "Post splitting" g return g @@ -355,7 +355,7 @@ dumpGraph dflags flag name g = do when (gopt Opt_DoCmmLinting dflags) $ do_lint g dumpWith dflags flag name FormatCMM (ppr g) where - do_lint g = case cmmLintGraph dflags g of + do_lint g = case cmmLintGraph (targetPlatform dflags) g of Just err -> do { fatalErrorMsg dflags err ; ghcExit dflags 1 } ===================================== compiler/GHC/Cmm/ProcPoint.hs ===================================== @@ -11,7 +11,6 @@ where import GHC.Prelude hiding (last, unzip, succ, zip) -import GHC.Driver.Session import GHC.Cmm.BlockId import GHC.Cmm.CLabel import GHC.Cmm @@ -238,9 +237,9 @@ extendPPSet platform g blocks procPoints = -- Input invariant: A block should only be reachable from a single ProcPoint. -- ToDo: use the _ret naming convention that the old code generator -- used. -- EZY -splitAtProcPoints :: DynFlags -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> +splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> CmmDecl -> UniqSM [CmmDecl] -splitAtProcPoints dflags entry_label callPPs procPoints procMap +splitAtProcPoints platform entry_label callPPs procPoints procMap (CmmProc (TopInfo {info_tbls = info_tbls}) top_l _ g@(CmmGraph {g_entry=entry})) = do -- Build a map from procpoints to the blocks they reach @@ -262,7 +261,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap where graph = mapLookup procId graphEnv `orElse` mapEmpty graph' = mapInsert bid b graph - let liveness = cmmGlobalLiveness dflags g + let liveness = cmmGlobalLiveness platform g let ppLiveness pp = filter isArgReg $ regSetToList $ expectJust "ppLiveness" $ mapLookup pp liveness @@ -316,7 +315,6 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap -- when jumping to a PP that has an info table, if -- tablesNextToCode is off we must jump to the entry -- label instead. - platform = targetPlatform dflags tablesNextToCode = platformTablesNextToCode platform jump_label (Just info_lbl) _ | tablesNextToCode = info_lbl ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -16,7 +16,6 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Driver.Session import GHC.Types.Unique import GHC.Types.Unique.FM @@ -165,10 +164,10 @@ type Assignments = [Assignment] -- y = e2 -- x = e1 -cmmSink :: DynFlags -> CmmGraph -> CmmGraph -cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks +cmmSink :: Platform -> CmmGraph -> CmmGraph +cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness dflags graph + liveness = cmmLocalLiveness platform graph getLive l = mapFindWithDefault Set.empty l liveness blocks = revPostorder graph @@ -181,7 +180,6 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- pprTrace "sink" (ppr lbl) $ blockJoin first final_middle final_last : sink sunk' bs where - platform = targetPlatform dflags lbl = entryLabel b (first, middle, last) = blockSplit b @@ -191,13 +189,13 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. live = Set.unions (map getLive succs) - live_middle = gen_kill dflags last live - ann_middles = annotate dflags live_middle (blockToList middle) + live_middle = gen_kill platform last live + ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block - (middle', assigs) = walk dflags ann_middles (mapFindWithDefault [] lbl sunk) + (middle', assigs) = walk platform ann_middles (mapFindWithDefault [] lbl sunk) fold_last = constantFoldNode platform last - (final_last, assigs') = tryToInline dflags live fold_last assigs + (final_last, assigs') = tryToInline platform live fold_last assigs -- We cannot sink into join points (successors with more than -- one predecessor), so identify the join points and the set @@ -217,12 +215,12 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks _ -> False -- Now, drop any assignments that we will not sink any further. - (dropped_last, assigs'') = dropAssignments dflags drop_if init_live_sets assigs' + (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where - should_drop = conflicts dflags a final_last - || not (isTrivial dflags rhs) && live_in_multi live_sets r + should_drop = conflicts platform a final_last + || not (isTrivial platform rhs) && live_in_multi live_sets r || r `Set.member` live_in_joins live_sets' | should_drop = live_sets @@ -231,12 +229,12 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks upd set | r `Set.member` set = set `Set.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed dflags extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last sunk' = mapUnion sunk $ - mapFromList [ (l, filterAssignments dflags (getLive l) assigs'') + mapFromList [ (l, filterAssignments platform (getLive l) assigs'') | l <- succs ] {- TODO: enable this later, when we have some good tests in place to @@ -255,12 +253,12 @@ isSmall _ = False -- We allow duplication of trivial expressions: registers (both local and -- global) and literals. -- -isTrivial :: DynFlags -> CmmExpr -> Bool +isTrivial :: Platform -> CmmExpr -> Bool isTrivial _ (CmmReg (CmmLocal _)) = True -isTrivial dflags (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?] - if isARM (platformArch (targetPlatform dflags)) +isTrivial platform (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?] + if isARM (platformArch platform) then True -- CodeGen.Platform.ARM does not have globalRegMaybe - else isJust (globalRegMaybe (targetPlatform dflags) r) + else isJust (globalRegMaybe platform r) -- GlobalRegs that are loads from BaseReg are not trivial isTrivial _ (CmmLit _) = True isTrivial _ _ = False @@ -268,9 +266,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: DynFlags -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] -annotate dflags live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill dflags n live, (live,n) : nodes) +annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate platform live nodes = snd $ foldr ann (live,[]) nodes + where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -287,14 +285,14 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: DynFlags -> LocalRegSet -> Assignments -> Assignments -filterAssignments dflags live assigs = reverse (go assigs []) +filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where needed = r `Set.member` live - || any (conflicts dflags a) (map toNode kept) + || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have -- already kept. @@ -313,7 +311,7 @@ filterAssignments dflags live assigs = reverse (go assigs []) -- * a list of assignments that will be placed *after* that block. -- -walk :: DynFlags +walk :: Platform -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -327,7 +325,7 @@ walk :: DynFlags , Assignments -- Assignments to sink further ) -walk dflags nodes assigs = go nodes emptyBlock assigs +walk platform nodes assigs = go nodes emptyBlock assigs where go [] block as = (block, as) go ((live,node):ns) block as @@ -336,13 +334,12 @@ walk dflags nodes assigs = go nodes emptyBlock assigs | Just a <- shouldSink platform node2 = go ns block (a : as1) | otherwise = go ns block' as' where - platform = targetPlatform dflags node1 = constantFoldNode platform node - (node2, as1) = tryToInline dflags live node1 as + (node2, as1) = tryToInline platform live node1 as - (dropped, as') = dropAssignmentsSimple dflags - (\a -> conflicts dflags a node2) as1 + (dropped, as') = dropAssignmentsSimple platform + (\a -> conflicts platform a node2) as1 block' = foldl' blockSnoc block dropped `blockSnoc` node2 @@ -380,13 +377,13 @@ shouldDiscard node live toNode :: Assignment -> CmmNode O O toNode (r,rhs,_) = CmmAssign (CmmLocal r) rhs -dropAssignmentsSimple :: DynFlags -> (Assignment -> Bool) -> Assignments +dropAssignmentsSimple :: Platform -> (Assignment -> Bool) -> Assignments -> ([CmmNode O O], Assignments) -dropAssignmentsSimple dflags f = dropAssignments dflags (\a _ -> (f a, ())) () +dropAssignmentsSimple platform f = dropAssignments platform (\a _ -> (f a, ())) () -dropAssignments :: DynFlags -> (Assignment -> s -> (Bool, s)) -> s -> Assignments +dropAssignments :: Platform -> (Assignment -> s -> (Bool, s)) -> s -> Assignments -> ([CmmNode O O], Assignments) -dropAssignments dflags should_drop state assigs +dropAssignments platform should_drop state assigs = (dropped, reverse kept) where (dropped,kept) = go state assigs [] [] @@ -397,7 +394,7 @@ dropAssignments dflags should_drop state assigs | otherwise = go state' rest dropped (assig:kept) where (dropit, state') = should_drop assig state - conflict = dropit || any (conflicts dflags assig) dropped + conflict = dropit || any (conflicts platform assig) dropped -- ----------------------------------------------------------------------------- @@ -406,7 +403,7 @@ dropAssignments dflags should_drop state assigs -- inlining opens up opportunities for doing so. tryToInline - :: DynFlags + :: Platform -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless @@ -418,10 +415,10 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline dflags live node assigs = go usages node emptyLRegSet assigs +tryToInline platform live node assigs = go usages node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used - usages = foldLocalRegsUsed dflags addUsage emptyUFM node + usages = foldLocalRegsUsed platform addUsage emptyUFM node go _usages node _skipped [] = (node, []) @@ -429,12 +426,11 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs | cannot_inline = dont_inline | occurs_none = discard -- Note [discard during inlining] | occurs_once = inline_and_discard - | isTrivial dflags rhs = inline_and_keep + | isTrivial platform rhs = inline_and_keep | otherwise = dont_inline where - platform = targetPlatform dflags inline_and_discard = go usages' inl_node skipped rest - where usages' = foldLocalRegsUsed dflags addUsage usages rhs + where usages' = foldLocalRegsUsed platform addUsage usages rhs discard = go usages node skipped rest @@ -443,7 +439,7 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs keep node' = (final_node, a : rest') where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest - usages' = foldLocalRegsUsed dflags (\m r -> addToUFM m r 2) + usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) usages rhs -- we must not inline anything that is mentioned in the RHS -- of a binding that we have already skipped, so we set the @@ -451,7 +447,7 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped - || not (okToInline dflags rhs node) + || not (okToInline platform rhs node) l_usages = lookupUFM usages l l_live = l `elemRegSet` live @@ -569,25 +565,25 @@ regsUsedIn ls e = wrapRecExpf f e False -- ought to be able to handle it properly, but currently neither PprC -- nor the NCG can do it. See Note [Register parameter passing] -- See also GHC.StgToCmm.Foreign.load_args_into_temps. -okToInline :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -okToInline dflags expr node@(CmmUnsafeForeignCall{}) = - not (globalRegistersConflict dflags expr node) +okToInline :: Platform -> CmmExpr -> CmmNode e x -> Bool +okToInline platform expr node@(CmmUnsafeForeignCall{}) = + not (globalRegistersConflict platform expr node) okToInline _ _ _ = True -- ----------------------------------------------------------------------------- -- | @conflicts (r,e) node@ is @False@ if and only if the assignment -- @r = e@ can be safely commuted past statement @node at . -conflicts :: DynFlags -> Assignment -> CmmNode O x -> Bool -conflicts dflags (r, rhs, addr) node +conflicts :: Platform -> Assignment -> CmmNode O x -> Bool +conflicts platform (r, rhs, addr) node -- (1) node defines registers used by rhs of assignment. This catches -- assignments and all three kinds of calls. See Note [Sinking and calls] - | globalRegistersConflict dflags rhs node = True - | localRegistersConflict dflags rhs node = True + | globalRegistersConflict platform rhs node = True + | localRegistersConflict platform rhs node = True -- (2) node uses register defined by assignment - | foldRegsUsed dflags (\b r' -> r == r' || b) False node = True + | foldRegsUsed platform (\b r' -> r == r' || b) False node = True -- (3) a store to an address conflicts with a read of the same memory | CmmStore addr' e <- node @@ -606,21 +602,19 @@ conflicts dflags (r, rhs, addr) node -- (7) otherwise, no conflict | otherwise = False - where - platform = targetPlatform dflags -- Returns True if node defines any global registers that are used in the -- Cmm expression -globalRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -globalRegistersConflict dflags expr node = - foldRegsDefd dflags (\b r -> b || regUsedIn (targetPlatform dflags) (CmmGlobal r) expr) +globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool +globalRegistersConflict platform expr node = + foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) False node -- Returns True if node defines any local registers that are used in the -- Cmm expression -localRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -localRegistersConflict dflags expr node = - foldRegsDefd dflags (\b r -> b || regUsedIn (targetPlatform dflags) (CmmLocal r) expr) +localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool +localRegistersConflict platform expr node = + foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) False node -- Note [Sinking and calls] ===================================== compiler/GHC/Cmm/Switch/Implement.hs ===================================== @@ -6,6 +6,7 @@ where import GHC.Prelude +import GHC.Driver.Backend import GHC.Platform import GHC.Cmm.Dataflow.Block import GHC.Cmm.BlockId @@ -13,7 +14,6 @@ import GHC.Cmm import GHC.Cmm.Utils import GHC.Cmm.Switch import GHC.Types.Unique.Supply -import GHC.Driver.Session import GHC.Utils.Monad (concatMapM) -- @@ -32,12 +32,12 @@ import GHC.Utils.Monad (concatMapM) -- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for -- code generation. -cmmImplementSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph -cmmImplementSwitchPlans dflags g +cmmImplementSwitchPlans :: Backend -> Platform -> CmmGraph -> UniqSM CmmGraph +cmmImplementSwitchPlans backend platform g -- Switch generation done by backend (LLVM/C) - | backendSupportsSwitch (backend dflags) = return g + | backendSupportsSwitch backend = return g | otherwise = do - blocks' <- concatMapM (visitSwitches (targetPlatform dflags)) (toBlockList g) + blocks' <- concatMapM (visitSwitches platform) (toBlockList g) return $ ofBlockList (g_entry g) blocks' visitSwitches :: Platform -> CmmBlock -> UniqSM [CmmBlock] ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -91,7 +91,7 @@ pprTop platform = \case blankLine, extern_decls, (if (externallyVisibleCLabel clbl) - then mkFN_ else mkIF_) (ppr clbl) <+> lbrace, + then mkFN_ else mkIF_) (pprCLabel_ViaC platform clbl) <+> lbrace, nest 8 temp_decls, vcat (map (pprBBlock platform) blocks), rbrace ] @@ -110,14 +110,14 @@ pprTop platform = \case (CmmData section (CmmStaticsRaw lbl [CmmString str])) -> pprExternDecl platform lbl $$ hcat [ - pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl, text "[] = ", pprStringInCStyle str, semi ] (CmmData section (CmmStaticsRaw lbl [CmmUninitialised size])) -> pprExternDecl platform lbl $$ hcat [ - pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl, brackets (int size), semi ] @@ -153,7 +153,7 @@ pprWordArray platform is_ro lbl ds = -- TODO: align closures only pprExternDecl platform lbl $$ hcat [ pprLocalness lbl, pprConstness is_ro, text "StgWord" - , space, ppr lbl, text "[]" + , space, pprCLabel_ViaC platform lbl, text "[]" -- See Note [StgWord alignment] , pprAlignment (wordWidth platform) , text "= {" ] @@ -238,7 +238,7 @@ pprStmt platform stmt = case fn of CmmLit (CmmLabel lbl) | StdCallConv <- cconv -> - pprCall platform (ppr lbl) cconv hresults hargs + pprCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs -- stdcall functions must be declared with -- a function type, otherwise the C compiler -- doesn't add the @n suffix to the label. We @@ -247,7 +247,7 @@ pprStmt platform stmt = | CmmNeverReturns <- ret -> pprCall platform cast_fn cconv hresults hargs <> semi | not (isMathFun lbl) -> - pprForeignCall platform (ppr lbl) cconv hresults hargs + pprForeignCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs _ -> pprCall platform cast_fn cconv hresults hargs <> semi -- for a dynamic call, no declaration is necessary. @@ -487,7 +487,7 @@ pprLit platform lit = case lit of -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i where - pprCLabelAddr lbl = char '&' <> ppr lbl + pprCLabelAddr lbl = char '&' <> pprCLabel_ViaC platform lbl pprLit1 :: Platform -> CmmLit -> SDoc pprLit1 platform lit = case lit of @@ -1047,7 +1047,7 @@ pprExternDecl platform lbl | not (needsCDecl lbl) = empty | Just sz <- foreignLabelStdcallInfo lbl = stdcall_decl sz | otherwise = - hcat [ visibility, label_type lbl , lparen, ppr lbl, text ");" + hcat [ visibility, label_type lbl , lparen, pprCLabel_ViaC platform lbl, text ");" -- occasionally useful to see label type -- , text "/* ", pprDebugCLabel lbl, text " */" ] @@ -1070,7 +1070,7 @@ pprExternDecl platform lbl -- we must generate an appropriate prototype for it, so that the C compiler will -- add the @n suffix to the label (#2276) stdcall_decl sz = - text "extern __attribute__((stdcall)) void " <> ppr lbl + text "extern __attribute__((stdcall)) void " <> pprCLabel_ViaC platform lbl <> parens (commafy (replicate (sz `quot` platformWordSizeInBytes platform) (machRep_U_CType platform (wordWidth platform)))) <> semi ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -51,8 +51,9 @@ module GHC.Core.DataCon ( splitDataProductType_maybe, -- ** Predicates on DataCons - isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon, - isUnboxedSumCon, + isNullarySrcDataCon, isNullaryRepDataCon, + isTupleDataCon, isBoxedTupleDataCon, isUnboxedTupleDataCon, + isUnboxedSumDataCon, isVanillaDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsArePermuted, isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked, @@ -1467,11 +1468,14 @@ dataConIdentity dc = LBS.toStrict $ BSB.toLazyByteString $ mconcat isTupleDataCon :: DataCon -> Bool isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc -isUnboxedTupleCon :: DataCon -> Bool -isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc +isBoxedTupleDataCon :: DataCon -> Bool +isBoxedTupleDataCon (MkData {dcRepTyCon = tc}) = isBoxedTupleTyCon tc -isUnboxedSumCon :: DataCon -> Bool -isUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc +isUnboxedTupleDataCon :: DataCon -> Bool +isUnboxedTupleDataCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc + +isUnboxedSumDataCon :: DataCon -> Bool +isUnboxedSumDataCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc -- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors isVanillaDataCon :: DataCon -> Bool ===================================== compiler/GHC/Core/DataCon.hs-boot ===================================== @@ -26,7 +26,7 @@ dataConInstOrigArgTys :: DataCon -> [Type] -> [Scaled Type] dataConStupidTheta :: DataCon -> ThetaType dataConFullSig :: DataCon -> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Scaled Type], Type) -isUnboxedSumCon :: DataCon -> Bool +isUnboxedSumDataCon :: DataCon -> Bool instance Eq DataCon instance Uniquable DataCon ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -359,7 +359,7 @@ forcesRealWorld fam_envs ty = True | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } <- deepSplitProductType_maybe fam_envs ty - , isUnboxedTupleCon dc + , isUnboxedTupleDataCon dc = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys | otherwise = False ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Core.Coercion.Opt ( optCoercion ) import GHC.Core.FamInstEnv ( topNormaliseType_maybe ) import GHC.Core.DataCon ( DataCon, dataConWorkId, dataConRepStrictness - , dataConRepArgTys, isUnboxedTupleCon + , dataConRepArgTys, isUnboxedTupleDataCon , StrictnessMark (..) ) import GHC.Core.Opt.Monad ( Tick(..), SimplMode(..) ) import GHC.Core @@ -2957,7 +2957,7 @@ addEvals :: Maybe OutExpr -> DataCon -> [Id] -> [Id] addEvals scrut con vs -- Deal with seq# applications | Just scr <- scrut - , isUnboxedTupleCon con + , isUnboxedTupleDataCon con , [s,x] <- vs -- Use stripNArgs rather than collectArgsTicks to avoid building -- a list of arguments only to throw it away immediately. ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -148,7 +148,7 @@ import {-# SOURCE #-} GHC.Builtin.Types import {-# SOURCE #-} GHC.Core.DataCon ( DataCon, dataConExTyCoVars, dataConFieldLabels , dataConTyCon, dataConFullSig - , isUnboxedSumCon ) + , isUnboxedSumDataCon ) import GHC.Builtin.Uniques ( tyConRepNameUnique , dataConTyRepNameUnique ) @@ -1323,7 +1323,7 @@ tyConRepName_maybe (AlgTyCon { algTcParent = parent }) tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm }) = Just rep_nm tyConRepName_maybe (PromotedDataCon { dataCon = dc, tcRepName = rep_nm }) - | isUnboxedSumCon dc -- see #13276 + | isUnboxedSumDataCon dc -- see #13276 = Nothing | otherwise = Just rep_nm ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -889,7 +889,7 @@ conSize dc n_val_args | n_val_args == 0 = SizeIs 0 emptyBag 10 -- Like variables -- See Note [Unboxed tuple size and result discount] - | isUnboxedTupleCon dc = SizeIs 0 emptyBag 10 + | isUnboxedTupleDataCon dc = SizeIs 0 emptyBag 10 -- See Note [Constructor size and result discount] | otherwise = SizeIs 10 emptyBag 10 ===================================== compiler/GHC/CoreToByteCode.hs ===================================== @@ -648,7 +648,7 @@ schemeE d s p (AnnCase (_,scrut) _ _ []) = schemeE d s p scrut -- handle pairs with one void argument (e.g. state token) schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)]) - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc -- Convert -- case .... of x { (# V'd-thing, a #) -> ... } -- to @@ -667,7 +667,7 @@ schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)]) -- handle unit tuples schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)]) - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc , typePrimRep (idType bndr) `lengthAtMost` 1 = doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr) @@ -825,7 +825,7 @@ schemeT d s p app -- Case 2: Constructor application | Just con <- maybe_saturated_dcon - , isUnboxedTupleCon con + , isUnboxedTupleDataCon con = case args_r_to_l of [arg1,arg2] | isVAtom arg1 -> unboxedTupleReturn d s p arg2 @@ -1090,7 +1090,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} my_discr (DataAlt dc, _, _) - | isUnboxedTupleCon dc || isUnboxedSumCon dc + | isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc = multiValException | otherwise = DiscrP (fromIntegral (dataConTag dc - fIRST_TAG)) ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -188,7 +188,7 @@ toIfaceTypeX fr (TyConApp tc tys) = IfaceTupleTy sort NotPromoted (toIfaceTcArgsX fr tc tys) | Just dc <- isPromotedDataCon_maybe tc - , isTupleDataCon dc + , isBoxedTupleDataCon dc , n_tys == 2*arity = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys)) ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -699,7 +699,7 @@ mkTopStgRhs dflags this_mod ccs bndr rhs , -- Dynamic StgConApps are updatable not (isDllConApp dflags this_mod con args) = -- CorePrep does this right, but just to make sure - ASSERT2( not (isUnboxedTupleCon con || isUnboxedSumCon con) + ASSERT2( not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) , ppr bndr $$ ppr con $$ ppr args) ( StgRhsCon dontCareCCS con args, ccs ) ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -83,7 +83,7 @@ codeOutput dflags this_mod filenm location foreign_stubs foreign_fps pkg_deps dflags (text "CmmLint"<+>brackets (ppr this_mod)) (const ()) $ do - { case cmmLint dflags cmm of + { case cmmLint (targetPlatform dflags) cmm of Just err -> do { log_action dflags dflags NoReason ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -172,7 +172,7 @@ pprConLike delta _prec cl args WcVarTerminated pref x -> parens . fcat . punctuate colon <$> mapM (pprPmVar appPrec) (toList pref ++ [x]) pprConLike _delta _prec (RealDataCon con) args - | isUnboxedTupleCon con + | isUnboxedTupleDataCon con , let hash_parens doc = text "(#" <+> doc <+> text "#)" = hash_parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args | isTupleDataCon con ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -164,7 +164,7 @@ lintStgRhs (StgRhsClosure _ _ _ binders expr) lintStgExpr expr lintStgRhs rhs@(StgRhsCon _ con args) = do - when (isUnboxedTupleCon con || isUnboxedSumCon con) $ do + when (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) $ do opts <- getStgPprOpts addErrL (text "StgRhsCon is an unboxed tuple or sum application" $$ pprStgRhs opts rhs) @@ -182,7 +182,7 @@ lintStgExpr (StgApp fun args) = do lintStgExpr app@(StgConApp con args _arg_tys) = do -- unboxed sums should vanish during unarise lf <- getLintFlags - when (lf_unarised lf && isUnboxedSumCon con) $ do + when (lf_unarised lf && isUnboxedSumDataCon con) $ do opts <- getStgPprOpts addErrL (text "Unboxed sum after unarise:" $$ pprStgExpr opts app) ===================================== compiler/GHC/Stg/Unarise.hs ===================================== @@ -294,7 +294,7 @@ unariseRhs rho (StgRhsClosure ext ccs update_flag args expr) return (StgRhsClosure ext ccs update_flag args1 expr') unariseRhs rho (StgRhsCon ccs con args) - = ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con)) + = ASSERT(not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con)) return (StgRhsCon ccs con (unariseConArgs rho args)) -------------------------------------------------------------------------------- @@ -372,10 +372,10 @@ unariseExpr rho (StgTick tick e) -- Doesn't return void args. unariseMulti_maybe :: UnariseEnv -> DataCon -> [InStgArg] -> [Type] -> Maybe [OutStgArg] unariseMulti_maybe rho dc args ty_args - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc = Just (unariseConArgs rho args) - | isUnboxedSumCon dc + | isUnboxedSumDataCon dc , let args1 = ASSERT(isSingleton args) (unariseConArgs rho args) = Just (mkUbxSum dc ty_args args1) ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -354,7 +354,7 @@ bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg] -- binders args, assuming that we have just returned from a 'case' which -- found a con bindConArgs (DataAlt con) base args - = ASSERT(not (isUnboxedTupleCon con)) + = ASSERT(not (isUnboxedTupleDataCon con)) do profile <- getProfile platform <- getPlatform let (_, _, args_w_offsets) = mkVirtConstrOffsets profile (addIdReps args) ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -837,7 +837,7 @@ maybeAltHeapCheck (GcInAlts regs, ReturnedTo lret off) code = cgConApp :: DataCon -> [StgArg] -> FCode ReturnKind cgConApp con stg_args - | isUnboxedTupleCon con -- Unboxed tuple: assign and return + | isUnboxedTupleDataCon con -- Unboxed tuple: assign and return = do { arg_exprs <- getNonVoidArgAmodes stg_args ; tickyUnboxedTupleReturn (length arg_exprs) ; emitReturn arg_exprs } ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -556,7 +556,7 @@ hasNoBinding :: Id -> Bool hasNoBinding id = case Var.idDetails id of PrimOpId _ -> True -- See Note [Eta expanding primops] in GHC.Builtin.PrimOps FCallId _ -> True - DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc + DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc _ -> isCompulsoryUnfolding (idUnfolding id) -- See Note [Levity-polymorphic Ids] ===================================== testsuite/tests/ghci/scripts/T18644.script ===================================== @@ -0,0 +1,3 @@ +:set -XDataKinds -XUnboxedTuples +:kind! '(# #) +:kind! '() ===================================== testsuite/tests/ghci/scripts/T18644.stdout ===================================== @@ -0,0 +1,4 @@ +'(# #) :: (# #) += '(# #) +'() :: () += '() ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -315,3 +315,4 @@ test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script']) +test('T18644', normal, ghci_script, ['T18644.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d54d95bc32bbd8f2ffc36a328a09838491bd6690...67076e23f335540017c0714663bbe3aa4b678d46 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d54d95bc32bbd8f2ffc36a328a09838491bd6690...67076e23f335540017c0714663bbe3aa4b678d46 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 15:10:56 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Fri, 04 Sep 2020 11:10:56 -0400 Subject: [Git][ghc/ghc][wip/wire-in-constraint-tuples] 2 commits: Hadrian: don't needlessly quote test_env for perf metrics Message-ID: <5f5259005d816_80b1073011c1061006a@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/wire-in-constraint-tuples at Glasgow Haskell Compiler / GHC Commits: 43e70b34 by Ryan Scott at 2020-09-04T11:09:18-04:00 Hadrian: don't needlessly quote test_env for perf metrics - - - - - ede82d8e by Ryan Scott at 2020-09-04T11:09:18-04:00 Wire in constraint tuples This wires in the definitions of the constraint tuple classes. The key changes are in: * `GHC.Builtin.Types`, where the `mk_ctuple` function is used to define constraint tuple type constructors, data constructors, and superclass selector functions, and * `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for constraint tuple type and data constructors, we now must wire in the superclass selector functions. Luckily, this proves to be not that challenging. See the newly added comments. Historical note: constraint tuples used to be wired-in until about five years ago, when commit 130e93aab220bdf14d08028771f83df210da340b turned them into known-key names. This was done as part of a larger refactor to reduce the number of special cases for constraint tuples, but the commit message notes that the main reason that constraint tuples were made known-key (as opposed to boxed/unboxed tuples, which are wired in) is because it was awkward to wire in the superclass selectors. This commit solves the problem of wiring in superclass selectors. Fixes #18635. ------------------------- Metric Decrease: T10421 T12150 T12227 T12234 T12425 T13056 T13253-spj T18282 T18304 T5321FD T5321Fun T5837 T9961 Metric Decrease (test_env='x86_64-linux-deb9-unreg-hadrian'): T12707 Metric Decrease (test_env='x86_64-darwin'): T4029 ------------------------- - - - - - 6 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/HsType.hs - hadrian/src/Settings/Builders/RunTest.hs Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -80,9 +80,10 @@ module GHC.Builtin.Types ( unboxedTupleKind, unboxedSumKind, -- ** Constraint tuples - cTupleTyConName, cTupleTyConNames, isCTupleTyConName, + cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName, cTupleTyConNameArity_maybe, - cTupleDataConName, cTupleDataConNames, + cTupleDataCon, cTupleDataConName, cTupleDataConNames, + cTupleSelId, cTupleSelIdName, -- * Any anyTyCon, anyTy, anyTypeOfKind, @@ -174,10 +175,9 @@ import GHC.Core.Class ( Class, mkClass ) import GHC.Types.Name.Reader import GHC.Types.Name as Name import GHC.Types.Name.Env ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF ) -import GHC.Types.Name.Set ( NameSet, mkNameSet, elemNameSet ) import GHC.Types.Basic import GHC.Types.ForeignCall -import GHC.Types.SrcLoc ( noSrcSpan ) +import GHC.Types.Unique.Set import Data.Array import GHC.Data.FastString import GHC.Data.BooleanFormula ( mkAnd ) @@ -723,20 +723,23 @@ Note [How tuples work] See also Note [Known-key names] in GHC.Builtin.Names but no actual declaration and no info table * ConstraintTuples - - Are known-key rather than wired-in. Reason: it's awkward to - have all the superclass selectors wired-in. + - A wired-in type. - Declared as classes in GHC.Classes, e.g. class (c1,c2) => (c1,c2) - Given constraints: the superclasses automatically become available - Wanted constraints: there is a built-in instance instance (c1,c2) => (c1,c2) - See GHC.Tc.Solver.Interact.matchCTuple + See GHC.Tc.Instance.Class.matchCTuple - Currently just go up to 62; beyond that you have to use manual nesting - Their OccNames look like (%,,,%), so they can easily be distinguished from term tuples. But (following Haskell) we pretty-print saturated constraint tuples with round parens; see BasicTypes.tupleParens. + - Unlike BoxedTuples and UnboxedTuples, which only wire + in type constructors and data constructors, ConstraintTuples also wire in + superclass selector functions. For instance, $p1(%,%) and $p2(%,%) are + the selectors for the binary constraint tuple. * In quite a lot of places things are restricted just to BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish @@ -914,26 +917,26 @@ mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)" commas :: Arity -> String commas ar = take (ar-1) (repeat ',') +cTupleTyCon :: Arity -> TyCon +cTupleTyCon i + | i > mAX_CTUPLE_SIZE = fstOf3 (mk_ctuple i) -- Build one specially + | otherwise = fstOf3 (cTupleArr ! i) + cTupleTyConName :: Arity -> Name -cTupleTyConName arity - = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES - (mkCTupleOcc tcName arity) noSrcSpan +cTupleTyConName a = tyConName (cTupleTyCon a) cTupleTyConNames :: [Name] cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) -cTupleTyConNameSet :: NameSet -cTupleTyConNameSet = mkNameSet cTupleTyConNames +cTupleTyConKeys :: UniqSet Unique +cTupleTyConKeys = mkUniqSet $ map getUnique cTupleTyConNames isCTupleTyConName :: Name -> Bool --- Use Type.isCTupleClass where possible isCTupleTyConName n = ASSERT2( isExternalName n, ppr n ) - nameModule n == gHC_CLASSES - && n `elemNameSet` cTupleTyConNameSet + getUnique n `elementOfUniqSet` cTupleTyConKeys -- | If the given name is that of a constraint tuple, return its arity. --- Note that this is inefficient. cTupleTyConNameArity_maybe :: Name -> Maybe Arity cTupleTyConNameArity_maybe n | not (isCTupleTyConName n) = Nothing @@ -943,14 +946,46 @@ cTupleTyConNameArity_maybe n -- case, we have to adjust accordingly our calculated arity. adjustArity a = if a > 0 then a + 1 else a +cTupleDataCon :: Arity -> DataCon +cTupleDataCon i + | i > mAX_CTUPLE_SIZE = sndOf3 (mk_ctuple i) -- Build one specially + | otherwise = sndOf3 (cTupleArr ! i) + cTupleDataConName :: Arity -> Name -cTupleDataConName arity - = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES - (mkCTupleOcc dataName arity) noSrcSpan +cTupleDataConName i = dataConName (cTupleDataCon i) cTupleDataConNames :: [Name] cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE]) +cTupleSelId :: ConTag -- Superclass position + -> Arity -- Arity + -> Id +cTupleSelId sc_pos arity + | sc_pos > arity + = panic ("cTupleSelId: index out of bounds: superclass position: " + ++ show sc_pos ++ " > arity " ++ show arity) + + | sc_pos <= 0 + = panic ("cTupleSelId: Superclass positions start from 1. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity < 2 + = panic ("cTupleSelId: Arity starts from 2. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity > mAX_CTUPLE_SIZE + = thdOf3 (mk_ctuple arity) ! (sc_pos - 1) -- Build one specially + + | otherwise + = thdOf3 (cTupleArr ! arity) ! (sc_pos - 1) + +cTupleSelIdName :: ConTag -- Superclass position + -> Arity -- Arity + -> Name +cTupleSelIdName sc_pos arity = idName (cTupleSelId sc_pos arity) + tupleTyCon :: Boxity -> Arity -> TyCon tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i) -- Build one specially tupleTyCon Boxed i = fst (boxedTupleArr ! i) @@ -976,6 +1011,20 @@ boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon) boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]] unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]] +-- | Cached type constructors, data constructors, and superclass selectors for +-- constraint tuples. The outer array is indexed by the arity of the constraint +-- tuple and the inner array is indexed by the superclass position. +cTupleArr :: Array Int (TyCon, DataCon, Array Int Id) +cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZE]] + -- Although GHC does not make use of unary constraint tuples + -- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType), + -- this array creates one anyway. This is primarily motivated by the fact + -- that (1) the indices of an Array must be contiguous, and (2) we would like + -- the index of a constraint tuple in this Array to correspond to its Arity. + -- We could envision skipping over the unary constraint tuple and having index + -- 1 correspond to a 2-constraint tuple (and so on), but that's more + -- complicated than it's worth. + -- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed -- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type -- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep @@ -1040,6 +1089,45 @@ mk_tuple Unboxed arity = (tycon, tuple_con) tc_uniq = mkTupleTyConUnique boxity arity dc_uniq = mkTupleDataConUnique boxity arity +mk_ctuple :: Arity -> (TyCon, DataCon, Array ConTagZ Id) +mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr) + where + tycon = mkClassTyCon tc_name binders roles + rhs klass + (mkPrelTyConRepName tc_name) + + klass = mk_ctuple_class tycon sc_theta sc_sel_ids + tuple_con = pcDataConW dc_name tvs (map unrestricted sc_theta) tycon + + binders = mkTemplateAnonTyConBinders (replicate arity constraintKind) + roles = replicate arity Nominal + rhs = TupleTyCon{data_con = tuple_con, tup_sort = ConstraintTuple} + + modu = gHC_CLASSES + tc_name = mkWiredInName modu (mkCTupleOcc tcName arity) tc_uniq + (ATyCon tycon) BuiltInSyntax + dc_name = mkWiredInName modu (mkCTupleOcc dataName arity) dc_uniq + (AConLike (RealDataCon tuple_con)) BuiltInSyntax + tc_uniq = mkCTupleTyConUnique arity + dc_uniq = mkCTupleDataConUnique arity + + tvs = binderVars binders + sc_theta = map mkTyVarTy tvs + sc_sel_ids = [mk_sc_sel_id sc_pos | sc_pos <- [0..arity-1]] + sc_sel_ids_arr = listArray (0,arity-1) sc_sel_ids + + mk_sc_sel_id sc_pos = + let sc_sel_id_uniq = mkCTupleSelIdUnique sc_pos arity + sc_sel_id_occ = mkCTupleOcc tcName arity + sc_sel_id_name = mkWiredInIdName + gHC_CLASSES + (occNameFS (mkSuperDictSelOcc sc_pos sc_sel_id_occ)) + sc_sel_id_uniq + sc_sel_id + sc_sel_id = mkDictSelId sc_sel_id_name klass + + in sc_sel_id + unitTyCon :: TyCon unitTyCon = tupleTyCon Boxed 0 @@ -1248,7 +1336,10 @@ mk_class tycon sc_pred sc_sel_id = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon - +mk_ctuple_class :: TyCon -> ThetaType -> [Id] -> Class +mk_ctuple_class tycon sc_theta sc_sel_ids + = mkClass (tyConName tycon) (tyConTyVars tycon) [] sc_theta sc_sel_ids + [] [] (mkAnd []) tycon {- ********************************************************************* * * ===================================== compiler/GHC/Builtin/Types.hs-boot ===================================== @@ -64,8 +64,10 @@ promotedTupleDataCon :: Boxity -> Arity -> TyCon tupleDataCon :: Boxity -> Arity -> DataCon tupleTyCon :: Boxity -> Arity -> TyCon +cTupleDataCon :: Arity -> DataCon cTupleDataConName :: Arity -> Name cTupleTyConName :: Arity -> Name +cTupleSelIdName :: ConTag -> Arity -> Name sumDataCon :: ConTag -> Arity -> DataCon sumTyCon :: Arity -> TyCon ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -22,6 +22,7 @@ module GHC.Builtin.Uniques -- *** Constraint , mkCTupleTyConUnique , mkCTupleDataConUnique + , mkCTupleSelIdUnique -- ** Making built-in uniques , mkAlphaTyVarUnique @@ -79,8 +80,9 @@ knownUniqueName u = '5' -> Just $ getTupleTyConName Unboxed n '7' -> Just $ getTupleDataConName Boxed n '8' -> Just $ getTupleDataConName Unboxed n + 'j' -> Just $ getCTupleSelIdName n 'k' -> Just $ getCTupleTyConName n - 'm' -> Just $ getCTupleDataConUnique n + 'm' -> Just $ getCTupleDataConName n _ -> Nothing where (tag, n) = unpkUnique u @@ -158,6 +160,21 @@ getUnboxedSumName n -------------------------------------------------- -- Constraint tuples +-- +-- Constraint tuples, like boxed and unboxed tuples, have their type and data +-- constructor Uniques wired in +-- (see Note [Uniques for tuple type and data constructors]). In addition, the +-- superclass selectors for each constraint tuple have wired-in Uniques. A +-- constraint tuple of arity n has n different selectors (e.g., the binary +-- constraint tuple has selectors $p1(%,%) and $p2(%,%)). +-- +-- The encoding of these selectors' Uniques takes somewhat resembles the +-- encoding for unboxed sums (see above). The integral part of the Unique +-- is broken up into bitfields for the arity and the position of the +-- superclass. Given a selector for a constraint tuple with arity n +-- (zero-based) and position k (where 1 <= k <= n), its Unique will look like: +-- +-- 00000000 nnnnnnnn kkkkkkkk mkCTupleTyConUnique :: Arity -> Unique mkCTupleTyConUnique a = mkUnique 'k' (2*a) @@ -165,6 +182,13 @@ mkCTupleTyConUnique a = mkUnique 'k' (2*a) mkCTupleDataConUnique :: Arity -> Unique mkCTupleDataConUnique a = mkUnique 'm' (3*a) +mkCTupleSelIdUnique :: ConTagZ -> Arity -> Unique +mkCTupleSelIdUnique sc_pos arity + | sc_pos >= arity + = panic ("mkCTupleSelIdUnique: " ++ show sc_pos ++ " >= " ++ show arity) + | otherwise + = mkUnique 'j' (arity `shiftL` 8 + sc_pos) + getCTupleTyConName :: Int -> Name getCTupleTyConName n = case n `divMod` 2 of @@ -172,14 +196,20 @@ getCTupleTyConName n = (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity _ -> panic "getCTupleTyConName: impossible" -getCTupleDataConUnique :: Int -> Name -getCTupleDataConUnique n = +getCTupleDataConName :: Int -> Name +getCTupleDataConName n = case n `divMod` 3 of (arity, 0) -> cTupleDataConName arity - (_arity, 1) -> panic "getCTupleDataConName: no worker" + (arity, 1) -> getName $ dataConWrapId $ cTupleDataCon arity (arity, 2) -> mkPrelTyConRepName $ cTupleDataConName arity _ -> panic "getCTupleDataConName: impossible" +getCTupleSelIdName :: Int -> Name +getCTupleSelIdName n = cTupleSelIdName (sc_pos + 1) arity + where + arity = n `shiftR` 8 + sc_pos = n .&. 0xff + -------------------------------------------------- -- Normal tuples @@ -230,6 +260,7 @@ Allocation of unique supply characters: d desugarer f AbsC flattener g SimplStg + j constraint tuple superclass selectors k constraint tuple tycons m constraint tuple datacons n Native codegen ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1203,10 +1203,9 @@ tcTupleTyCon :: Bool -- True <=> typechecking a *type* (vs. an expr) -> IfL TyCon tcTupleTyCon in_type sort arity = case sort of - ConstraintTuple -> do { thing <- tcIfaceGlobal (cTupleTyConName arity) - ; return (tyThingTyCon thing) } - BoxedTuple -> return (tupleTyCon Boxed arity) - UnboxedTuple -> return (tupleTyCon Unboxed arity') + ConstraintTuple -> return (cTupleTyCon arity) + BoxedTuple -> return (tupleTyCon Boxed arity) + UnboxedTuple -> return (tupleTyCon Unboxed arity') where arity' | in_type = arity `div` 2 | otherwise = arity -- in expressions, we only have term args ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1269,8 +1269,8 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do | arity > mAX_CTUPLE_SIZE -> failWith (bigConstraintTuple arity) | otherwise - -> do tycon <- tcLookupTyCon (cTupleTyConName arity) - check_expected_kind (mkTyConApp tycon tau_tys) constraintKind + -> let tycon = cTupleTyCon arity in + check_expected_kind (mkTyConApp tycon tau_tys) constraintKind BoxedTuple -> do let tycon = tupleTyCon Boxed arity checkWiredInTyCon tycon ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -142,7 +142,7 @@ runTestBuilderArgs = builder RunTest ? do , case perfBaseline of Just commit | not (null commit) -> arg ("--perf-baseline=" ++ show commit) _ -> mempty - , emitWhenSet testEnv $ \env -> arg ("--test-env=" ++ show env) + , emitWhenSet testEnv $ \env -> arg ("--test-env=" ++ env) , emitWhenSet testMetricsFile $ \file -> arg ("--metrics-file=" ++ file) , getTestArgs -- User-provided arguments from command line. ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dcdf784827c632b61c3ec0e551578b7d90f17df6...ede82d8e6cbea05acf7a06a1845c30efc8a14c2d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dcdf784827c632b61c3ec0e551578b7d90f17df6...ede82d8e6cbea05acf7a06a1845c30efc8a14c2d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 16:02:30 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 12:02:30 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] gitlab-ci: Bump Docker images Message-ID: <5f526516d2c5c_80b3f8434f6e5f810613088@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 76730390 by Ben Gamari at 2020-09-04T12:02:21-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: bbb39306d7736906e3c943641854a47ccdde0e07 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7673039067a5876a782c016cca38166c046bdbac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7673039067a5876a782c016cca38166c046bdbac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 16:05:35 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 12:05:35 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] gitlab-ci: Bump Docker images Message-ID: <5f5265cfc16aa_80b3f8486a529c8106134bd@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: c8525e21 by Ben Gamari at 2020-09-04T12:05:26-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: bbb39306d7736906e3c943641854a47ccdde0e07 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8525e21a73e9620f73735f874afc09b5ab3d338 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8525e21a73e9620f73735f874afc09b5ab3d338 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 16:24:23 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 12:24:23 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] gitlab-ci: Bump Docker images Message-ID: <5f526a3782f04_80b82899a4106138e9@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 9f01c56f by Ben Gamari at 2020-09-04T12:24:17-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: bbb39306d7736906e3c943641854a47ccdde0e07 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f01c56fc98cfc03f62a3428a50680451818d125 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f01c56fc98cfc03f62a3428a50680451818d125 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 16:37:49 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 12:37:49 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] gitlab-ci: Bump Docker images Message-ID: <5f526d5ddda55_80b3f84739cdc5410614254@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 4d435604 by Ben Gamari at 2020-09-04T12:37:02-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: bbb39306d7736906e3c943641854a47ccdde0e07 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d4356041add33a4648e8062bc12a242d627baeb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4d4356041add33a4648e8062bc12a242d627baeb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 16:51:25 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 12:51:25 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] gitlab-ci: Bump Docker images Message-ID: <5f52708dc3b5f_80b3f8495815818106146db@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 61093edf by Ben Gamari at 2020-09-04T12:51:18-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: bbb39306d7736906e3c943641854a47ccdde0e07 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61093edf651ed56d9905c04259400b7ff2eaf177 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/61093edf651ed56d9905c04259400b7ff2eaf177 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 16:56:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 12:56:03 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 2 commits: users-guide: A few release notes fixes Message-ID: <5f5271a35948_80b3f8456798e3810617590@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: a6809cf8 by Ben Gamari at 2020-09-02T15:27:27-04:00 users-guide: A few release notes fixes - - - - - 2dbdb7b9 by GHC GitLab CI at 2020-09-03T19:55:38-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). (cherry picked from commit 34e0fa963f35a77093fc7111a80c557fc6bd614f) - - - - - 8 changed files: - aclocal.m4 - compiler/GHC/Settings/IO.hs - configure.ac - docs/users_guide/9.0.1-notes.rst - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - mk/config.mk.in - rules/build-package-way.mk Changes: ===================================== aclocal.m4 ===================================== @@ -516,6 +516,10 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="${mingw_bin_prefix}gcc.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="${mingw_bin_prefix}ld.exe" + # Overrides FIND_MERGE_OBJECTS in order to avoid hard-coding linker + # path on Windows (#18550). + SettingsMergeObjectsCommand="${SettingsLdCommand}" + SettingsMergeObjectsFlags="-r --oformat=pe-bigobj-x86-64" SettingsArCommand="${mingw_bin_prefix}ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}dllwrap.exe" @@ -529,6 +533,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" + SettingsMergeObjectsCommand="$(basename $MergeObjsCmd)" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$(basename $ArCmd)" SettingsDllWrapCommand="$(basename $DllWrapCmd)" SettingsWindresCommand="$(basename $WindresCmd)" @@ -538,6 +544,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$LdCmd" + SettingsMergeObjectsCommand="$MergeObjsCmd" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" if test -z "$DllWrapCmd" @@ -592,6 +600,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) AC_SUBST(SettingsLdFlags) + AC_SUBST(SettingsMergeObjectsCommand) + AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsDllWrapCommand) @@ -2605,7 +2615,7 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ ]) $CC -c -o conftest.a.o conftest.a.c || AC_MSG_ERROR([Failed to compile test]) - $SettingsMergeObjectsCommand $SettingsMergeObjectsFlags -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) + $MergeObjsCmd $MergeObjsArgs -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) $CC -c -o conftest.main.o conftest.main.c || AC_MSG_ERROR([Failed to compile test driver]) $CC conftest.ar.o conftest.main.o -o conftest || AC_MSG_ERROR([Failed to link test driver]) @@ -2625,33 +2635,30 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ # ------------------ # Find which linker to use to merge object files. # +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_REQUIRE([FIND_LD]) - if test -z "$SettingsMergeObjectsCommand"; then - SettingsMergeObjectsCommand="$LD" + if test -z "$MergeObjsCmd"; then + MergeObjsCmd="$LD" fi - if test -z "$SettingsMergeObjectsFlags"; then - SettingsMergeObjectsFlags="-r" + if test -z "$MergeObjsArgs"; then + MergeObjsArgs="-r" fi - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_NOTICE([$SettingsMergeObjectsCommand is broken due to binutils 22266, looking for another linker...]) - SettingsMergeObjectsCommand="" - AC_CHECK_TARGET_TOOL([SettingsMergeObjectsCommand], [ld]) - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + AC_MSG_NOTICE([$MergeObjsCmd is broken due to binutils 22266, looking for another linker...]) + MergeObjsCmd="" + AC_CHECK_TARGET_TOOL([MergeObjsCmd], [ld]) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the SettingsMergeObjectsCommand variable to a functional linker.]) + AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the MergeObjsCmd variable to a functional linker.]) fi fi - if test "$windows" = YES -a "$EnableDistroToolchain" = "NO" -a "$WORD_SIZE" = 64; then - SettingsMergeObjectsFlags="$SettingsMergeObjectsFlags --oformat=pe-bigobj-x86-64" - fi - - AC_SUBST(SettingsMergeObjectsCommand) - AC_SUBST(SettingsMergeObjectsFlags) + AC_SUBST([MergeObjsCmd]) + AC_SUBST([MergeObjsArgs]) ]) # FIND_PYTHON ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -138,7 +138,7 @@ initSettings top_dir = do as_args = map Option cc_args ld_prog = cc_prog ld_args = map Option (cc_args ++ words cc_link_args_str) - ld_r_prog <- getSetting "Merge objects command" + ld_r_prog <- getToolSetting "Merge objects command" ld_r_args <- getSetting "Merge objects flags" llvmTarget <- getSetting "LLVM target" ===================================== configure.ac ===================================== @@ -448,6 +448,8 @@ then NM="${mingwbin}nm.exe" RANLIB="${mingwbin}ranlib.exe" OBJDUMP="${mingwbin}objdump.exe" + MergeObjsCmd="$LD" + MergeObjsArgs="-r --oformat=pe-bigobj-x86-64" fp_prog_ar="${mingwbin}ar.exe" AC_PATH_PROG([Genlib],[genlib]) ===================================== docs/users_guide/9.0.1-notes.rst ===================================== @@ -37,24 +37,24 @@ Highlights f True = 1 f x = ... case x of { False -> 2; True -> 3 } ... - GHC is now able to detect the case alt returning 3 as redundant. + GHC is now able to detect the case alternative returning ``3`` as redundant. - Some more performance improvements in edge cases. -* Windows: Use the larg address space allocator. +* Windows: Use the large address-space allocator. This improves runtime but causes increased memory usage on Windows versions older than Win 8.1/Server 2012. * Big-number support - - GHC now relies on a new "ghc-bignum" package to provide Integer/Natural + - GHC now relies on a new ``ghc-bignum`` package to provide Integer/Natural implementations. This package supports the following backends: - gmp: adapted from integer-gmp package that was used before - - native: new Haskell implementation, faster than integer-simple which is + - native: new Haskell implementation, faster than ``integer-simple`` which is not used anymore - All backends now use the same representation for big numbers (the one that - was previously used only by integer-gmp). It led to several compiler + was previously used only by ``integer-gmp``). It led to several compiler simplifications, performance improvements and bug fixes (e.g. :ghc-ticket:`15262`, :ghc-ticket:`15286`). @@ -62,10 +62,10 @@ Highlights deterministic results so that they can be tested one against the other (they can only differ in performance). As a consequence, some functions that were only provided by integer-gmp (prime test, secure powmod, etc.) are no longer - provided by ghc-bignum. Note that other packages (e.g. hgmp) provide these + provided by ghc-bignum. Note that other packages (e.g. ``hgmp``) provide these functions. - - For now GHC still doesn't allow dynamic selection of the ghc-bignum backend + - For now GHC still doesn't allow dynamic selection of the ``ghc-bignum`` backend to use. * Breaking change: Template Haskell splices now act as separation points ===================================== hadrian/cfg/system.config.in ===================================== @@ -14,6 +14,7 @@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ nm = @NmCmd@ +merge-objects = @MergeObjsCmd@ objdump = @ObjdumpCmd@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ @@ -115,10 +116,10 @@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ -conf-merge-objects-args-stage0 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage1 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage2 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage3 = @SettingsMergeObjectsFlags@ +conf-merge-objects-args-stage0 = @MergeObjsArgs@ +conf-merge-objects-args-stage1 = @MergeObjsArgs@ +conf-merge-objects-args-stage2 = @MergeObjsArgs@ +conf-merge-objects-args-stage3 = @MergeObjsArgs@ # Settings: ===================================== hadrian/src/Builder.hs ===================================== @@ -312,7 +312,7 @@ systemBuilderPath builder = case builder of Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" Ld _ -> fromKey "ld" - MergeObjects _ -> fromKey "settings-merge-objects-command" + MergeObjects _ -> fromKey "merge-objects" Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" Nm -> fromKey "nm" ===================================== mk/config.mk.in ===================================== @@ -544,6 +544,16 @@ LD_STAGE1 = $(LD) LD_STAGE2 = $(LD) LD_STAGE3 = $(LD) +MERGE_OBJS_STAGE0 = @MergeObjsCmd@ +MERGE_OBJS_STAGE1 = @MergeObjsCmd@ +MERGE_OBJS_STAGE2 = @MergeObjsCmd@ +MERGE_OBJS_STAGE3 = @MergeObjsCmd@ + +MERGE_OBJS_STAGE0_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE1_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE2_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE3_FLAGS = @MergeObjsArgs@ + # Cross-compiling options # See Note [CrossCompiling vs Stage1Only] CrossCompiling = @CrossCompiling@ ===================================== rules/build-package-way.mk ===================================== @@ -107,6 +107,7 @@ endif endif # Build the GHCi library +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. ifneq "$(filter $3, v p)" "" $1_$2_$3_GHCI_LIB = $1/$2/build/HS$$($1_$2_COMPONENT_ID).$$($3_osuf) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" @@ -116,7 +117,7 @@ BINDIST_LIBS += $$($1_$2_$3_GHCI_LIB) endif endif $$($1_$2_$3_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) $$($1_$2_LD_SCRIPT) - $$(call cmd,SettingsMergeObjectsCommand) $(SettingsMergeObjectsFlags) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) + $$(call cmd,MERGE_OBJS_STAGE$4) $(MERGE_OBJS_STAGE$4_FLAGS) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" # Don't bother making ghci libs for bootstrapping packages ifneq "$4" "0" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5c3a027ec0536bd4c36d99b4101aedf55a2d7d1...2dbdb7b9f3c4f10566072f18d7b5f11a9d330211 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d5c3a027ec0536bd4c36d99b4101aedf55a2d7d1...2dbdb7b9f3c4f10566072f18d7b5f11a9d330211 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 16:56:03 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 12:56:03 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports Message-ID: <5f5271a3172b4_80b3f84867fd650106177e0@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/backports at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 16:59:27 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 12:59:27 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] gitlab-ci: Bump Docker images Message-ID: <5f52726faf02c_80b3f848a33ea5c106179b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: d2153392 by Ben Gamari at 2020-09-04T12:59:18-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: bbb39306d7736906e3c943641854a47ccdde0e07 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d215339293434d28720caaf79312f57b3582fa95 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d215339293434d28720caaf79312f57b3582fa95 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 17:21:07 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 13:21:07 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] gitlab-ci: Bump Docker images Message-ID: <5f527783368ab_80b3f8486f49e5410618392@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: a010d212 by Ben Gamari at 2020-09-04T13:21:01-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: bbb39306d7736906e3c943641854a47ccdde0e07 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +207,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a010d21240e15fb1e1966466700ceaf2301cd9d6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a010d21240e15fb1e1966466700ceaf2301cd9d6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 18:51:08 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 14:51:08 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports-8.10 Message-ID: <5f528c9cd71d7_80bf2d0fdc1062679b@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backports-8.10 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports-8.10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 19:06:06 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 15:06:06 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] gitlab-ci: Bump Docker images Message-ID: <5f52901ef05ad_80b3f8468ee18901062943e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 03caf67a by Ben Gamari at 2020-09-04T15:05:57-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: 95d7e7a4908cf9bb15c7f55455405412a6d07bec # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +207,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03caf67a484e59a684aa1df384ad9b8e5c0ffee4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03caf67a484e59a684aa1df384ad9b8e5c0ffee4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 20:24:28 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Sep 2020 16:24:28 -0400 Subject: [Git][ghc/ghc][master] Don't rely on CLabel's Outputable instance in CmmToC Message-ID: <5f52a27c92934_80b3f849c3ceb7c10653149@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 2 changed files: - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/CmmToC.hs Changes: ===================================== compiler/GHC/Cmm/CLabel.hs ===================================== @@ -108,7 +108,7 @@ module GHC.Cmm.CLabel ( -- * Conversions toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName, - pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, + pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, pprCLabel_ViaC, isInfoTableLabel, isConInfoTableLabel, isIdLabel, isTickyLabel @@ -1218,11 +1218,15 @@ pprCLabel bcknd platform lbl = case bcknd of NCG -> pprCLabel_NCG platform lbl LLVM -> pprCLabel_LLVM platform lbl + ViaC -> pprCLabel_ViaC platform lbl _ -> pprCLabel_other platform lbl pprCLabel_LLVM :: Platform -> CLabel -> SDoc pprCLabel_LLVM = pprCLabel_NCG +pprCLabel_ViaC :: Platform -> CLabel -> SDoc +pprCLabel_ViaC = pprCLabel_other + pprCLabel_NCG :: Platform -> CLabel -> SDoc pprCLabel_NCG platform lbl = getPprStyle $ \sty -> let @@ -1348,7 +1352,13 @@ pprCLabel_common platform = \case (ForeignLabel str _ _ _) -> ftext str - (IdLabel name _cafs flavor) -> internalNamePrefix platform name <> ppr name <> ppIdFlavor flavor + (IdLabel name _cafs flavor) -> internalNamePrefix <> ppr name <> ppIdFlavor flavor + where + isRandomGenerated = not (isExternalName name) + internalNamePrefix = getPprStyle $ \ sty -> + if asmStyle sty && isRandomGenerated + then ptext (asmTempLabelPrefix platform) + else empty (CC_Label cc) -> ppr cc (CCS_Label ccs) -> ppr ccs @@ -1389,15 +1399,6 @@ instance Outputable ForeignLabelSource where ForeignLabelInThisPackage -> parens $ text "this package" ForeignLabelInExternalPackage -> parens $ text "external package" -internalNamePrefix :: Platform -> Name -> SDoc -internalNamePrefix platform name = getPprStyle $ \ sty -> - if asmStyle sty && isRandomGenerated then - ptext (asmTempLabelPrefix platform) - else - empty - where - isRandomGenerated = not $ isExternalName name - tempLabelPrefixOrUnderscore :: Platform -> SDoc tempLabelPrefixOrUnderscore platform = getPprStyle $ \ sty -> ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -91,7 +91,7 @@ pprTop platform = \case blankLine, extern_decls, (if (externallyVisibleCLabel clbl) - then mkFN_ else mkIF_) (ppr clbl) <+> lbrace, + then mkFN_ else mkIF_) (pprCLabel_ViaC platform clbl) <+> lbrace, nest 8 temp_decls, vcat (map (pprBBlock platform) blocks), rbrace ] @@ -110,14 +110,14 @@ pprTop platform = \case (CmmData section (CmmStaticsRaw lbl [CmmString str])) -> pprExternDecl platform lbl $$ hcat [ - pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl, text "[] = ", pprStringInCStyle str, semi ] (CmmData section (CmmStaticsRaw lbl [CmmUninitialised size])) -> pprExternDecl platform lbl $$ hcat [ - pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl, + pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl, brackets (int size), semi ] @@ -153,7 +153,7 @@ pprWordArray platform is_ro lbl ds = -- TODO: align closures only pprExternDecl platform lbl $$ hcat [ pprLocalness lbl, pprConstness is_ro, text "StgWord" - , space, ppr lbl, text "[]" + , space, pprCLabel_ViaC platform lbl, text "[]" -- See Note [StgWord alignment] , pprAlignment (wordWidth platform) , text "= {" ] @@ -238,7 +238,7 @@ pprStmt platform stmt = case fn of CmmLit (CmmLabel lbl) | StdCallConv <- cconv -> - pprCall platform (ppr lbl) cconv hresults hargs + pprCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs -- stdcall functions must be declared with -- a function type, otherwise the C compiler -- doesn't add the @n suffix to the label. We @@ -247,7 +247,7 @@ pprStmt platform stmt = | CmmNeverReturns <- ret -> pprCall platform cast_fn cconv hresults hargs <> semi | not (isMathFun lbl) -> - pprForeignCall platform (ppr lbl) cconv hresults hargs + pprForeignCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs _ -> pprCall platform cast_fn cconv hresults hargs <> semi -- for a dynamic call, no declaration is necessary. @@ -487,7 +487,7 @@ pprLit platform lit = case lit of -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i where - pprCLabelAddr lbl = char '&' <> ppr lbl + pprCLabelAddr lbl = char '&' <> pprCLabel_ViaC platform lbl pprLit1 :: Platform -> CmmLit -> SDoc pprLit1 platform lit = case lit of @@ -1047,7 +1047,7 @@ pprExternDecl platform lbl | not (needsCDecl lbl) = empty | Just sz <- foreignLabelStdcallInfo lbl = stdcall_decl sz | otherwise = - hcat [ visibility, label_type lbl , lparen, ppr lbl, text ");" + hcat [ visibility, label_type lbl , lparen, pprCLabel_ViaC platform lbl, text ");" -- occasionally useful to see label type -- , text "/* ", pprDebugCLabel lbl, text " */" ] @@ -1070,7 +1070,7 @@ pprExternDecl platform lbl -- we must generate an appropriate prototype for it, so that the C compiler will -- add the @n suffix to the label (#2276) stdcall_decl sz = - text "extern __attribute__((stdcall)) void " <> ppr lbl + text "extern __attribute__((stdcall)) void " <> pprCLabel_ViaC platform lbl <> parens (commafy (replicate (sz `quot` platformWordSizeInBytes platform) (machRep_U_CType platform (wordWidth platform)))) <> semi View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d6d648866da9e7754859c48235f8009b8c130fd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d6d648866da9e7754859c48235f8009b8c130fd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 20:25:14 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Sep 2020 16:25:14 -0400 Subject: [Git][ghc/ghc][master] 2 commits: DynFlags: use Platform in foldRegs* Message-ID: <5f52a2aa49a73_80b3f83da799918106556c9@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - 10 changed files: - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/Driver/CodeOutput.hs Changes: ===================================== compiler/GHC/Cmm/Expr.hs ===================================== @@ -38,7 +38,6 @@ import GHC.Cmm.BlockId import GHC.Cmm.CLabel import GHC.Cmm.MachOp import GHC.Cmm.Type -import GHC.Driver.Session import GHC.Utils.Panic (panic) import GHC.Types.Unique @@ -331,17 +330,17 @@ sizeRegSet = Set.size regSetToList = Set.toList class Ord r => UserOfRegs r a where - foldRegsUsed :: DynFlags -> (b -> r -> b) -> b -> a -> b + foldRegsUsed :: Platform -> (b -> r -> b) -> b -> a -> b foldLocalRegsUsed :: UserOfRegs LocalReg a - => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b + => Platform -> (b -> LocalReg -> b) -> b -> a -> b foldLocalRegsUsed = foldRegsUsed class Ord r => DefinerOfRegs r a where - foldRegsDefd :: DynFlags -> (b -> r -> b) -> b -> a -> b + foldRegsDefd :: Platform -> (b -> r -> b) -> b -> a -> b foldLocalRegsDefd :: DefinerOfRegs LocalReg a - => DynFlags -> (b -> LocalReg -> b) -> b -> a -> b + => Platform -> (b -> LocalReg -> b) -> b -> a -> b foldLocalRegsDefd = foldRegsDefd instance UserOfRegs LocalReg CmmReg where @@ -369,20 +368,20 @@ instance Ord r => DefinerOfRegs r r where instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance - foldRegsUsed dflags f !z e = expr z e + foldRegsUsed platform f !z e = expr z e where expr z (CmmLit _) = z - expr z (CmmLoad addr _) = foldRegsUsed dflags f z addr - expr z (CmmReg r) = foldRegsUsed dflags f z r - expr z (CmmMachOp _ exprs) = foldRegsUsed dflags f z exprs - expr z (CmmRegOff r _) = foldRegsUsed dflags f z r + expr z (CmmLoad addr _) = foldRegsUsed platform f z addr + expr z (CmmReg r) = foldRegsUsed platform f z r + expr z (CmmMachOp _ exprs) = foldRegsUsed platform f z exprs + expr z (CmmRegOff r _) = foldRegsUsed platform f z r expr z (CmmStackSlot _ _) = z instance UserOfRegs r a => UserOfRegs r [a] where - foldRegsUsed dflags f set as = foldl' (foldRegsUsed dflags f) set as + foldRegsUsed platform f set as = foldl' (foldRegsUsed platform f) set as {-# INLINABLE foldRegsUsed #-} instance DefinerOfRegs r a => DefinerOfRegs r [a] where - foldRegsDefd dflags f set as = foldl' (foldRegsDefd dflags f) set as + foldRegsDefd platform f set as = foldl' (foldRegsDefd platform f) set as {-# INLINABLE foldRegsDefd #-} ----------------------------------------------------------------------------- ===================================== compiler/GHC/Cmm/LayoutStack.hs ===================================== @@ -246,9 +246,10 @@ cmmLayoutStack dflags procpoints entry_args = do -- We need liveness info. Dead assignments are removed later -- by the sinking pass. - let liveness = cmmLocalLiveness dflags graph + let liveness = cmmLocalLiveness platform graph blocks = revPostorder graph - profile = targetProfile dflags + profile = targetProfile dflags + platform = profilePlatform profile (final_stackmaps, _final_high_sp, new_blocks) <- mfix $ \ ~(rec_stackmaps, rec_high_sp, _new_blocks) -> @@ -256,7 +257,7 @@ cmmLayoutStack dflags procpoints entry_args rec_stackmaps rec_high_sp blocks blocks_with_reloads <- - insertReloadsAsNeeded dflags procpoints final_stackmaps entry new_blocks + insertReloadsAsNeeded platform procpoints final_stackmaps entry new_blocks new_blocks' <- mapM (lowerSafeForeignCall profile) blocks_with_reloads return (ofBlockList entry new_blocks', final_stackmaps) @@ -1044,30 +1045,29 @@ stackMapToLiveness platform StackMap{..} = -- ----------------------------------------------------------------------------- insertReloadsAsNeeded - :: DynFlags + :: Platform -> ProcPointSet -> LabelMap StackMap -> BlockId -> [CmmBlock] -> UniqSM [CmmBlock] -insertReloadsAsNeeded dflags procpoints final_stackmaps entry blocks = do +insertReloadsAsNeeded platform procpoints final_stackmaps entry blocks = do toBlockList . fst <$> rewriteCmmBwd liveLattice rewriteCC (ofBlockList entry blocks) mapEmpty where rewriteCC :: RewriteFun CmmLocalLive rewriteCC (BlockCC e_node middle0 x_node) fact_base0 = do let entry_label = entryLabel e_node - platform = targetPlatform dflags stackmap = case mapLookup entry_label final_stackmaps of Just sm -> sm Nothing -> panic "insertReloadsAsNeeded: rewriteCC: stackmap" -- Merge the liveness from successor blocks and analyse the last -- node. - joined = gen_kill dflags x_node $! + joined = gen_kill platform x_node $! joinOutFacts liveLattice x_node fact_base0 -- What is live at the start of middle0. - live_at_middle0 = foldNodesBwdOO (gen_kill dflags) middle0 joined + live_at_middle0 = foldNodesBwdOO (gen_kill platform) middle0 joined -- If this is a procpoint we need to add the reloads, but only if -- they're actually live. Furthermore, nothing is live at the entry ===================================== compiler/GHC/Cmm/Lint.hs ===================================== @@ -26,7 +26,6 @@ import GHC.Cmm.Liveness import GHC.Cmm.Switch (switchTargetsToList) import GHC.Cmm.Ppr () -- For Outputable instances import GHC.Utils.Outputable -import GHC.Driver.Session import Control.Monad (ap, unless) @@ -39,37 +38,38 @@ import Control.Monad (ap, unless) -- Exported entry points: cmmLint :: (Outputable d, Outputable h) - => DynFlags -> GenCmmGroup d h CmmGraph -> Maybe SDoc -cmmLint dflags tops = runCmmLint dflags (mapM_ (lintCmmDecl dflags)) tops + => Platform -> GenCmmGroup d h CmmGraph -> Maybe SDoc +cmmLint platform tops = runCmmLint platform (mapM_ lintCmmDecl) tops -cmmLintGraph :: DynFlags -> CmmGraph -> Maybe SDoc -cmmLintGraph dflags g = runCmmLint dflags (lintCmmGraph dflags) g +cmmLintGraph :: Platform -> CmmGraph -> Maybe SDoc +cmmLintGraph platform g = runCmmLint platform lintCmmGraph g -runCmmLint :: Outputable a => DynFlags -> (a -> CmmLint b) -> a -> Maybe SDoc -runCmmLint dflags l p = - case unCL (l p) dflags of +runCmmLint :: Outputable a => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc +runCmmLint platform l p = + case unCL (l p) platform of Left err -> Just (vcat [text "Cmm lint error:", nest 2 err, text "Program was:", nest 2 (ppr p)]) Right _ -> Nothing -lintCmmDecl :: DynFlags -> GenCmmDecl h i CmmGraph -> CmmLint () -lintCmmDecl dflags (CmmProc _ lbl _ g) - = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph dflags g -lintCmmDecl _ (CmmData {}) +lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint () +lintCmmDecl (CmmProc _ lbl _ g) + = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph g +lintCmmDecl (CmmData {}) = return () -lintCmmGraph :: DynFlags -> CmmGraph -> CmmLint () -lintCmmGraph dflags g = - cmmLocalLiveness dflags g `seq` mapM_ (lintCmmBlock labels) blocks - -- cmmLiveness throws an error if there are registers - -- live on entry to the graph (i.e. undefined - -- variables) - where - blocks = toBlockList g - labels = setFromList (map entryLabel blocks) +lintCmmGraph :: CmmGraph -> CmmLint () +lintCmmGraph g = do + platform <- getPlatform + let + blocks = toBlockList g + labels = setFromList (map entryLabel blocks) + cmmLocalLiveness platform g `seq` mapM_ (lintCmmBlock labels) blocks + -- cmmLiveness throws an error if there are registers + -- live on entry to the graph (i.e. undefined + -- variables) lintCmmBlock :: LabelSet -> CmmBlock -> CmmLint () @@ -225,9 +225,9 @@ lintTarget (PrimTarget {}) = return () mayNotMentionCallerSavedRegs :: (UserOfRegs GlobalReg a, Outputable a) => SDoc -> a -> CmmLint () mayNotMentionCallerSavedRegs what thing = do - dflags <- getDynFlags - let badRegs = filter (callerSaves (targetPlatform dflags)) - $ foldRegsUsed dflags (flip (:)) [] thing + platform <- getPlatform + let badRegs = filter (callerSaves platform) + $ foldRegsUsed platform (flip (:)) [] thing unless (null badRegs) $ cmmLintErr (what <+> text "mentions caller-saved registers: " <> ppr badRegs $$ ppr thing) @@ -243,7 +243,7 @@ checkCond _ expr -- just a basic error monad: -newtype CmmLint a = CmmLint { unCL :: DynFlags -> Either SDoc a } +newtype CmmLint a = CmmLint { unCL :: Platform -> Either SDoc a } deriving (Functor) instance Applicative CmmLint where @@ -251,23 +251,20 @@ instance Applicative CmmLint where (<*>) = ap instance Monad CmmLint where - CmmLint m >>= k = CmmLint $ \dflags -> - case m dflags of + CmmLint m >>= k = CmmLint $ \platform -> + case m platform of Left e -> Left e - Right a -> unCL (k a) dflags - -instance HasDynFlags CmmLint where - getDynFlags = CmmLint (\dflags -> Right dflags) + Right a -> unCL (k a) platform getPlatform :: CmmLint Platform -getPlatform = targetPlatform <$> getDynFlags +getPlatform = CmmLint $ \platform -> Right platform cmmLintErr :: SDoc -> CmmLint a cmmLintErr msg = CmmLint (\_ -> Left msg) addLintInfo :: SDoc -> CmmLint a -> CmmLint a -addLintInfo info thing = CmmLint $ \dflags -> - case unCL thing dflags of +addLintInfo info thing = CmmLint $ \platform -> + case unCL thing platform of Left err -> Left (hang info 2 err) Right a -> Right a ===================================== compiler/GHC/Cmm/Liveness.hs ===================================== @@ -14,7 +14,7 @@ where import GHC.Prelude -import GHC.Driver.Session +import GHC.Platform import GHC.Cmm.BlockId import GHC.Cmm import GHC.Cmm.Ppr.Expr () -- For Outputable instances @@ -52,17 +52,17 @@ type BlockEntryLiveness r = LabelMap (CmmLive r) -- | Calculated liveness info for a CmmGraph ----------------------------------------------------------------------------- -cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg -cmmLocalLiveness dflags graph = - check $ analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty +cmmLocalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg +cmmLocalLiveness platform graph = + check $ analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty where entry = g_entry graph check facts = noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts -cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg -cmmGlobalLiveness dflags graph = - analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty +cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalReg +cmmGlobalLiveness platform graph = + analyzeCmmBwd liveLattice (xferLive platform) graph mapEmpty -- | On entry to the procedure, there had better not be any LocalReg's live-in. noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a @@ -72,10 +72,10 @@ noLiveOnEntry bid in_fact x = gen_kill :: (DefinerOfRegs r n, UserOfRegs r n) - => DynFlags -> n -> CmmLive r -> CmmLive r -gen_kill dflags node set = - let !afterKill = foldRegsDefd dflags deleteFromRegSet set node - in foldRegsUsed dflags extendRegSet afterKill node + => Platform -> n -> CmmLive r -> CmmLive r +gen_kill platform node set = + let !afterKill = foldRegsDefd platform deleteFromRegSet set node + in foldRegsUsed platform extendRegSet afterKill node {-# INLINE gen_kill #-} xferLive @@ -85,10 +85,10 @@ xferLive , UserOfRegs r (CmmNode O C) , DefinerOfRegs r (CmmNode O C) ) - => DynFlags -> TransferFun (CmmLive r) -xferLive dflags (BlockCC eNode middle xNode) fBase = - let joined = gen_kill dflags xNode $! joinOutFacts liveLattice xNode fBase - !result = foldNodesBwdOO (gen_kill dflags) middle joined + => Platform -> TransferFun (CmmLive r) +xferLive platform (BlockCC eNode middle xNode) fBase = + let joined = gen_kill platform xNode $! joinOutFacts liveLattice xNode fBase + !result = foldNodesBwdOO (gen_kill platform) middle joined in mapSingleton (entryLabel eNode) result -{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-} -{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-} +{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-} +{-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-} ===================================== compiler/GHC/Cmm/Node.hs ===================================== @@ -31,7 +31,6 @@ import GHC.Prelude hiding (succ) import GHC.Platform.Regs import GHC.Cmm.Expr import GHC.Cmm.Switch -import GHC.Driver.Session import GHC.Data.FastString import GHC.Types.ForeignCall import GHC.Utils.Outputable @@ -320,7 +319,7 @@ foreignTargetHints target -- Instances of register and slot users / definers instance UserOfRegs LocalReg (CmmNode e x) where - foldRegsUsed dflags f !z n = case n of + foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args @@ -331,10 +330,10 @@ instance UserOfRegs LocalReg (CmmNode e x) where _ -> z where fold :: forall a b. UserOfRegs LocalReg a => (b -> LocalReg -> b) -> b -> a -> b - fold f z n = foldRegsUsed dflags f z n + fold f z n = foldRegsUsed platform f z n instance UserOfRegs GlobalReg (CmmNode e x) where - foldRegsUsed dflags f !z n = case n of + foldRegsUsed platform f !z n = case n of CmmAssign _ expr -> fold f z expr CmmStore addr rval -> fold f (fold f z addr) rval CmmUnsafeForeignCall t _ args -> fold f (fold f z t) args @@ -345,26 +344,26 @@ instance UserOfRegs GlobalReg (CmmNode e x) where _ -> z where fold :: forall a b. UserOfRegs GlobalReg a => (b -> GlobalReg -> b) -> b -> a -> b - fold f z n = foldRegsUsed dflags f z n + fold f z n = foldRegsUsed platform f z n instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r ForeignTarget where -- The (Ord r) in the context is necessary here -- See Note [Recursive superclasses] in GHC.Tc.TyCl.Instance - foldRegsUsed _ _ !z (PrimTarget _) = z - foldRegsUsed dflags f !z (ForeignTarget e _) = foldRegsUsed dflags f z e + foldRegsUsed _ _ !z (PrimTarget _) = z + foldRegsUsed platform f !z (ForeignTarget e _) = foldRegsUsed platform f z e instance DefinerOfRegs LocalReg (CmmNode e x) where - foldRegsDefd dflags f !z n = case n of + foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall _ fs _ -> fold f z fs CmmForeignCall {res=res} -> fold f z res _ -> z where fold :: forall a b. DefinerOfRegs LocalReg a => (b -> LocalReg -> b) -> b -> a -> b - fold f z n = foldRegsDefd dflags f z n + fold f z n = foldRegsDefd platform f z n instance DefinerOfRegs GlobalReg (CmmNode e x) where - foldRegsDefd dflags f !z n = case n of + foldRegsDefd platform f !z n = case n of CmmAssign lhs _ -> fold f z lhs CmmUnsafeForeignCall tgt _ _ -> fold f z (foreignTargetRegs tgt) CmmCall {} -> fold f z activeRegs @@ -373,9 +372,8 @@ instance DefinerOfRegs GlobalReg (CmmNode e x) where _ -> z where fold :: forall a b. DefinerOfRegs GlobalReg a => (b -> GlobalReg -> b) -> b -> a -> b - fold f z n = foldRegsDefd dflags f z n + fold f z n = foldRegsDefd platform f z n - platform = targetPlatform dflags activeRegs = activeStgRegs platform activeCallerSavesRegs = filter (callerSaves platform) activeRegs ===================================== compiler/GHC/Cmm/Pipeline.hs ===================================== @@ -86,7 +86,7 @@ cpsTop dflags proc = ----------- Implement switches ------------------------------------------ g <- {-# SCC "createSwitchPlans" #-} - runUniqSM $ cmmImplementSwitchPlans dflags g + runUniqSM $ cmmImplementSwitchPlans (backend dflags) platform g dump Opt_D_dump_cmm_switch "Post switch plan" g ----------- Proc points ------------------------------------------------- @@ -97,7 +97,7 @@ cpsTop dflags proc = if splitting_proc_points then do pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $ - minimalProcPointSet (targetPlatform dflags) call_pps g + minimalProcPointSet platform call_pps g dumpWith dflags Opt_D_dump_cmm_proc "Proc points" FormatCMM (ppr l $$ ppr pp $$ ppr g) return pp @@ -114,7 +114,7 @@ cpsTop dflags proc = ----------- Sink and inline assignments -------------------------------- g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout] - condPass Opt_CmmSink (cmmSink dflags) g + condPass Opt_CmmSink (cmmSink platform) g Opt_D_dump_cmm_sink "Sink assignments" ------------- CAF analysis ---------------------------------------------- @@ -129,7 +129,7 @@ cpsTop dflags proc = dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map" FormatCMM (ppr pp_map) g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $ - splitAtProcPoints dflags l call_pps proc_points pp_map + splitAtProcPoints platform l call_pps proc_points pp_map (CmmProc h l v g) dumps Opt_D_dump_cmm_split "Post splitting" g return g @@ -355,7 +355,7 @@ dumpGraph dflags flag name g = do when (gopt Opt_DoCmmLinting dflags) $ do_lint g dumpWith dflags flag name FormatCMM (ppr g) where - do_lint g = case cmmLintGraph dflags g of + do_lint g = case cmmLintGraph (targetPlatform dflags) g of Just err -> do { fatalErrorMsg dflags err ; ghcExit dflags 1 } ===================================== compiler/GHC/Cmm/ProcPoint.hs ===================================== @@ -11,7 +11,6 @@ where import GHC.Prelude hiding (last, unzip, succ, zip) -import GHC.Driver.Session import GHC.Cmm.BlockId import GHC.Cmm.CLabel import GHC.Cmm @@ -238,9 +237,9 @@ extendPPSet platform g blocks procPoints = -- Input invariant: A block should only be reachable from a single ProcPoint. -- ToDo: use the _ret naming convention that the old code generator -- used. -- EZY -splitAtProcPoints :: DynFlags -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> +splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> CmmDecl -> UniqSM [CmmDecl] -splitAtProcPoints dflags entry_label callPPs procPoints procMap +splitAtProcPoints platform entry_label callPPs procPoints procMap (CmmProc (TopInfo {info_tbls = info_tbls}) top_l _ g@(CmmGraph {g_entry=entry})) = do -- Build a map from procpoints to the blocks they reach @@ -262,7 +261,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap where graph = mapLookup procId graphEnv `orElse` mapEmpty graph' = mapInsert bid b graph - let liveness = cmmGlobalLiveness dflags g + let liveness = cmmGlobalLiveness platform g let ppLiveness pp = filter isArgReg $ regSetToList $ expectJust "ppLiveness" $ mapLookup pp liveness @@ -316,7 +315,6 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap -- when jumping to a PP that has an info table, if -- tablesNextToCode is off we must jump to the entry -- label instead. - platform = targetPlatform dflags tablesNextToCode = platformTablesNextToCode platform jump_label (Just info_lbl) _ | tablesNextToCode = info_lbl ===================================== compiler/GHC/Cmm/Sink.hs ===================================== @@ -16,7 +16,6 @@ import GHC.Cmm.Dataflow.Graph import GHC.Platform.Regs import GHC.Platform -import GHC.Driver.Session import GHC.Types.Unique import GHC.Types.Unique.FM @@ -165,10 +164,10 @@ type Assignments = [Assignment] -- y = e2 -- x = e1 -cmmSink :: DynFlags -> CmmGraph -> CmmGraph -cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks +cmmSink :: Platform -> CmmGraph -> CmmGraph +cmmSink platform graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks where - liveness = cmmLocalLiveness dflags graph + liveness = cmmLocalLiveness platform graph getLive l = mapFindWithDefault Set.empty l liveness blocks = revPostorder graph @@ -181,7 +180,6 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- pprTrace "sink" (ppr lbl) $ blockJoin first final_middle final_last : sink sunk' bs where - platform = targetPlatform dflags lbl = entryLabel b (first, middle, last) = blockSplit b @@ -191,13 +189,13 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks -- the node. This will help us decide whether we can inline -- an assignment in the current node or not. live = Set.unions (map getLive succs) - live_middle = gen_kill dflags last live - ann_middles = annotate dflags live_middle (blockToList middle) + live_middle = gen_kill platform last live + ann_middles = annotate platform live_middle (blockToList middle) -- Now sink and inline in this block - (middle', assigs) = walk dflags ann_middles (mapFindWithDefault [] lbl sunk) + (middle', assigs) = walk platform ann_middles (mapFindWithDefault [] lbl sunk) fold_last = constantFoldNode platform last - (final_last, assigs') = tryToInline dflags live fold_last assigs + (final_last, assigs') = tryToInline platform live fold_last assigs -- We cannot sink into join points (successors with more than -- one predecessor), so identify the join points and the set @@ -217,12 +215,12 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks _ -> False -- Now, drop any assignments that we will not sink any further. - (dropped_last, assigs'') = dropAssignments dflags drop_if init_live_sets assigs' + (dropped_last, assigs'') = dropAssignments platform drop_if init_live_sets assigs' drop_if a@(r,rhs,_) live_sets = (should_drop, live_sets') where - should_drop = conflicts dflags a final_last - || not (isTrivial dflags rhs) && live_in_multi live_sets r + should_drop = conflicts platform a final_last + || not (isTrivial platform rhs) && live_in_multi live_sets r || r `Set.member` live_in_joins live_sets' | should_drop = live_sets @@ -231,12 +229,12 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks upd set | r `Set.member` set = set `Set.union` live_rhs | otherwise = set - live_rhs = foldRegsUsed dflags extendRegSet emptyRegSet rhs + live_rhs = foldRegsUsed platform extendRegSet emptyRegSet rhs final_middle = foldl' blockSnoc middle' dropped_last sunk' = mapUnion sunk $ - mapFromList [ (l, filterAssignments dflags (getLive l) assigs'') + mapFromList [ (l, filterAssignments platform (getLive l) assigs'') | l <- succs ] {- TODO: enable this later, when we have some good tests in place to @@ -255,12 +253,12 @@ isSmall _ = False -- We allow duplication of trivial expressions: registers (both local and -- global) and literals. -- -isTrivial :: DynFlags -> CmmExpr -> Bool +isTrivial :: Platform -> CmmExpr -> Bool isTrivial _ (CmmReg (CmmLocal _)) = True -isTrivial dflags (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?] - if isARM (platformArch (targetPlatform dflags)) +isTrivial platform (CmmReg (CmmGlobal r)) = -- see Note [Inline GlobalRegs?] + if isARM (platformArch platform) then True -- CodeGen.Platform.ARM does not have globalRegMaybe - else isJust (globalRegMaybe (targetPlatform dflags) r) + else isJust (globalRegMaybe platform r) -- GlobalRegs that are loads from BaseReg are not trivial isTrivial _ (CmmLit _) = True isTrivial _ _ = False @@ -268,9 +266,9 @@ isTrivial _ _ = False -- -- annotate each node with the set of registers live *after* the node -- -annotate :: DynFlags -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] -annotate dflags live nodes = snd $ foldr ann (live,[]) nodes - where ann n (live,nodes) = (gen_kill dflags n live, (live,n) : nodes) +annotate :: Platform -> LocalRegSet -> [CmmNode O O] -> [(LocalRegSet, CmmNode O O)] +annotate platform live nodes = snd $ foldr ann (live,[]) nodes + where ann n (live,nodes) = (gen_kill platform n live, (live,n) : nodes) -- -- Find the blocks that have multiple successors (join points) @@ -287,14 +285,14 @@ findJoinPoints blocks = mapFilter (>1) succ_counts -- filter the list of assignments to remove any assignments that -- are not live in a continuation. -- -filterAssignments :: DynFlags -> LocalRegSet -> Assignments -> Assignments -filterAssignments dflags live assigs = reverse (go assigs []) +filterAssignments :: Platform -> LocalRegSet -> Assignments -> Assignments +filterAssignments platform live assigs = reverse (go assigs []) where go [] kept = kept go (a@(r,_,_):as) kept | needed = go as (a:kept) | otherwise = go as kept where needed = r `Set.member` live - || any (conflicts dflags a) (map toNode kept) + || any (conflicts platform a) (map toNode kept) -- Note that we must keep assignments that are -- referred to by other assignments we have -- already kept. @@ -313,7 +311,7 @@ filterAssignments dflags live assigs = reverse (go assigs []) -- * a list of assignments that will be placed *after* that block. -- -walk :: DynFlags +walk :: Platform -> [(LocalRegSet, CmmNode O O)] -- nodes of the block, annotated with -- the set of registers live *after* -- this node. @@ -327,7 +325,7 @@ walk :: DynFlags , Assignments -- Assignments to sink further ) -walk dflags nodes assigs = go nodes emptyBlock assigs +walk platform nodes assigs = go nodes emptyBlock assigs where go [] block as = (block, as) go ((live,node):ns) block as @@ -336,13 +334,12 @@ walk dflags nodes assigs = go nodes emptyBlock assigs | Just a <- shouldSink platform node2 = go ns block (a : as1) | otherwise = go ns block' as' where - platform = targetPlatform dflags node1 = constantFoldNode platform node - (node2, as1) = tryToInline dflags live node1 as + (node2, as1) = tryToInline platform live node1 as - (dropped, as') = dropAssignmentsSimple dflags - (\a -> conflicts dflags a node2) as1 + (dropped, as') = dropAssignmentsSimple platform + (\a -> conflicts platform a node2) as1 block' = foldl' blockSnoc block dropped `blockSnoc` node2 @@ -380,13 +377,13 @@ shouldDiscard node live toNode :: Assignment -> CmmNode O O toNode (r,rhs,_) = CmmAssign (CmmLocal r) rhs -dropAssignmentsSimple :: DynFlags -> (Assignment -> Bool) -> Assignments +dropAssignmentsSimple :: Platform -> (Assignment -> Bool) -> Assignments -> ([CmmNode O O], Assignments) -dropAssignmentsSimple dflags f = dropAssignments dflags (\a _ -> (f a, ())) () +dropAssignmentsSimple platform f = dropAssignments platform (\a _ -> (f a, ())) () -dropAssignments :: DynFlags -> (Assignment -> s -> (Bool, s)) -> s -> Assignments +dropAssignments :: Platform -> (Assignment -> s -> (Bool, s)) -> s -> Assignments -> ([CmmNode O O], Assignments) -dropAssignments dflags should_drop state assigs +dropAssignments platform should_drop state assigs = (dropped, reverse kept) where (dropped,kept) = go state assigs [] [] @@ -397,7 +394,7 @@ dropAssignments dflags should_drop state assigs | otherwise = go state' rest dropped (assig:kept) where (dropit, state') = should_drop assig state - conflict = dropit || any (conflicts dflags assig) dropped + conflict = dropit || any (conflicts platform assig) dropped -- ----------------------------------------------------------------------------- @@ -406,7 +403,7 @@ dropAssignments dflags should_drop state assigs -- inlining opens up opportunities for doing so. tryToInline - :: DynFlags + :: Platform -> LocalRegSet -- set of registers live after this -- node. We cannot inline anything -- that is live after the node, unless @@ -418,10 +415,10 @@ tryToInline , Assignments -- Remaining assignments ) -tryToInline dflags live node assigs = go usages node emptyLRegSet assigs +tryToInline platform live node assigs = go usages node emptyLRegSet assigs where usages :: UniqFM LocalReg Int -- Maps each LocalReg to a count of how often it is used - usages = foldLocalRegsUsed dflags addUsage emptyUFM node + usages = foldLocalRegsUsed platform addUsage emptyUFM node go _usages node _skipped [] = (node, []) @@ -429,12 +426,11 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs | cannot_inline = dont_inline | occurs_none = discard -- Note [discard during inlining] | occurs_once = inline_and_discard - | isTrivial dflags rhs = inline_and_keep + | isTrivial platform rhs = inline_and_keep | otherwise = dont_inline where - platform = targetPlatform dflags inline_and_discard = go usages' inl_node skipped rest - where usages' = foldLocalRegsUsed dflags addUsage usages rhs + where usages' = foldLocalRegsUsed platform addUsage usages rhs discard = go usages node skipped rest @@ -443,7 +439,7 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs keep node' = (final_node, a : rest') where (final_node, rest') = go usages' node' (insertLRegSet l skipped) rest - usages' = foldLocalRegsUsed dflags (\m r -> addToUFM m r 2) + usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) usages rhs -- we must not inline anything that is mentioned in the RHS -- of a binding that we have already skipped, so we set the @@ -451,7 +447,7 @@ tryToInline dflags live node assigs = go usages node emptyLRegSet assigs cannot_inline = skipped `regsUsedIn` rhs -- Note [dependent assignments] || l `elemLRegSet` skipped - || not (okToInline dflags rhs node) + || not (okToInline platform rhs node) l_usages = lookupUFM usages l l_live = l `elemRegSet` live @@ -569,25 +565,25 @@ regsUsedIn ls e = wrapRecExpf f e False -- ought to be able to handle it properly, but currently neither PprC -- nor the NCG can do it. See Note [Register parameter passing] -- See also GHC.StgToCmm.Foreign.load_args_into_temps. -okToInline :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -okToInline dflags expr node@(CmmUnsafeForeignCall{}) = - not (globalRegistersConflict dflags expr node) +okToInline :: Platform -> CmmExpr -> CmmNode e x -> Bool +okToInline platform expr node@(CmmUnsafeForeignCall{}) = + not (globalRegistersConflict platform expr node) okToInline _ _ _ = True -- ----------------------------------------------------------------------------- -- | @conflicts (r,e) node@ is @False@ if and only if the assignment -- @r = e@ can be safely commuted past statement @node at . -conflicts :: DynFlags -> Assignment -> CmmNode O x -> Bool -conflicts dflags (r, rhs, addr) node +conflicts :: Platform -> Assignment -> CmmNode O x -> Bool +conflicts platform (r, rhs, addr) node -- (1) node defines registers used by rhs of assignment. This catches -- assignments and all three kinds of calls. See Note [Sinking and calls] - | globalRegistersConflict dflags rhs node = True - | localRegistersConflict dflags rhs node = True + | globalRegistersConflict platform rhs node = True + | localRegistersConflict platform rhs node = True -- (2) node uses register defined by assignment - | foldRegsUsed dflags (\b r' -> r == r' || b) False node = True + | foldRegsUsed platform (\b r' -> r == r' || b) False node = True -- (3) a store to an address conflicts with a read of the same memory | CmmStore addr' e <- node @@ -606,21 +602,19 @@ conflicts dflags (r, rhs, addr) node -- (7) otherwise, no conflict | otherwise = False - where - platform = targetPlatform dflags -- Returns True if node defines any global registers that are used in the -- Cmm expression -globalRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -globalRegistersConflict dflags expr node = - foldRegsDefd dflags (\b r -> b || regUsedIn (targetPlatform dflags) (CmmGlobal r) expr) +globalRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool +globalRegistersConflict platform expr node = + foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmGlobal r) expr) False node -- Returns True if node defines any local registers that are used in the -- Cmm expression -localRegistersConflict :: DynFlags -> CmmExpr -> CmmNode e x -> Bool -localRegistersConflict dflags expr node = - foldRegsDefd dflags (\b r -> b || regUsedIn (targetPlatform dflags) (CmmLocal r) expr) +localRegistersConflict :: Platform -> CmmExpr -> CmmNode e x -> Bool +localRegistersConflict platform expr node = + foldRegsDefd platform (\b r -> b || regUsedIn platform (CmmLocal r) expr) False node -- Note [Sinking and calls] ===================================== compiler/GHC/Cmm/Switch/Implement.hs ===================================== @@ -6,6 +6,7 @@ where import GHC.Prelude +import GHC.Driver.Backend import GHC.Platform import GHC.Cmm.Dataflow.Block import GHC.Cmm.BlockId @@ -13,7 +14,6 @@ import GHC.Cmm import GHC.Cmm.Utils import GHC.Cmm.Switch import GHC.Types.Unique.Supply -import GHC.Driver.Session import GHC.Utils.Monad (concatMapM) -- @@ -32,12 +32,12 @@ import GHC.Utils.Monad (concatMapM) -- | Traverses the 'CmmGraph', making sure that 'CmmSwitch' are suitable for -- code generation. -cmmImplementSwitchPlans :: DynFlags -> CmmGraph -> UniqSM CmmGraph -cmmImplementSwitchPlans dflags g +cmmImplementSwitchPlans :: Backend -> Platform -> CmmGraph -> UniqSM CmmGraph +cmmImplementSwitchPlans backend platform g -- Switch generation done by backend (LLVM/C) - | backendSupportsSwitch (backend dflags) = return g + | backendSupportsSwitch backend = return g | otherwise = do - blocks' <- concatMapM (visitSwitches (targetPlatform dflags)) (toBlockList g) + blocks' <- concatMapM (visitSwitches platform) (toBlockList g) return $ ofBlockList (g_entry g) blocks' visitSwitches :: Platform -> CmmBlock -> UniqSM [CmmBlock] ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -83,7 +83,7 @@ codeOutput dflags this_mod filenm location foreign_stubs foreign_fps pkg_deps dflags (text "CmmLint"<+>brackets (ppr this_mod)) (const ()) $ do - { case cmmLint dflags cmm of + { case cmmLint (targetPlatform dflags) cmm of Just err -> do { log_action dflags dflags NoReason View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d6d648866da9e7754859c48235f8009b8c130fd...220ad8d67af345cf3decf82ff26c1e696d21ac93 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1d6d648866da9e7754859c48235f8009b8c130fd...220ad8d67af345cf3decf82ff26c1e696d21ac93 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 20:25:43 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Sep 2020 16:25:43 -0400 Subject: [Git][ghc/ghc][master] Introduce isBoxedTupleDataCon and use it to fix #18644 Message-ID: <5f52a2c78b325_80b3f848a3a0c981065976a@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 18 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Types/Id.hs - + testsuite/tests/ghci/scripts/T18644.script - + testsuite/tests/ghci/scripts/T18644.stdout - testsuite/tests/ghci/scripts/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -51,8 +51,9 @@ module GHC.Core.DataCon ( splitDataProductType_maybe, -- ** Predicates on DataCons - isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon, - isUnboxedSumCon, + isNullarySrcDataCon, isNullaryRepDataCon, + isTupleDataCon, isBoxedTupleDataCon, isUnboxedTupleDataCon, + isUnboxedSumDataCon, isVanillaDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsArePermuted, isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked, @@ -1467,11 +1468,14 @@ dataConIdentity dc = LBS.toStrict $ BSB.toLazyByteString $ mconcat isTupleDataCon :: DataCon -> Bool isTupleDataCon (MkData {dcRepTyCon = tc}) = isTupleTyCon tc -isUnboxedTupleCon :: DataCon -> Bool -isUnboxedTupleCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc +isBoxedTupleDataCon :: DataCon -> Bool +isBoxedTupleDataCon (MkData {dcRepTyCon = tc}) = isBoxedTupleTyCon tc -isUnboxedSumCon :: DataCon -> Bool -isUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc +isUnboxedTupleDataCon :: DataCon -> Bool +isUnboxedTupleDataCon (MkData {dcRepTyCon = tc}) = isUnboxedTupleTyCon tc + +isUnboxedSumDataCon :: DataCon -> Bool +isUnboxedSumDataCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc -- | Vanilla 'DataCon's are those that are nice boring Haskell 98 constructors isVanillaDataCon :: DataCon -> Bool ===================================== compiler/GHC/Core/DataCon.hs-boot ===================================== @@ -26,7 +26,7 @@ dataConInstOrigArgTys :: DataCon -> [Type] -> [Scaled Type] dataConStupidTheta :: DataCon -> ThetaType dataConFullSig :: DataCon -> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Scaled Type], Type) -isUnboxedSumCon :: DataCon -> Bool +isUnboxedSumDataCon :: DataCon -> Bool instance Eq DataCon instance Uniquable DataCon ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -359,7 +359,7 @@ forcesRealWorld fam_envs ty = True | Just DataConAppContext{ dcac_dc = dc, dcac_arg_tys = field_tys } <- deepSplitProductType_maybe fam_envs ty - , isUnboxedTupleCon dc + , isUnboxedTupleDataCon dc = any (\(ty,_) -> scaledThing ty `eqType` realWorldStatePrimTy) field_tys | otherwise = False ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -34,7 +34,7 @@ import GHC.Core.Coercion.Opt ( optCoercion ) import GHC.Core.FamInstEnv ( topNormaliseType_maybe ) import GHC.Core.DataCon ( DataCon, dataConWorkId, dataConRepStrictness - , dataConRepArgTys, isUnboxedTupleCon + , dataConRepArgTys, isUnboxedTupleDataCon , StrictnessMark (..) ) import GHC.Core.Opt.Monad ( Tick(..), SimplMode(..) ) import GHC.Core @@ -2957,7 +2957,7 @@ addEvals :: Maybe OutExpr -> DataCon -> [Id] -> [Id] addEvals scrut con vs -- Deal with seq# applications | Just scr <- scrut - , isUnboxedTupleCon con + , isUnboxedTupleDataCon con , [s,x] <- vs -- Use stripNArgs rather than collectArgsTicks to avoid building -- a list of arguments only to throw it away immediately. ===================================== compiler/GHC/Core/TyCon.hs ===================================== @@ -148,7 +148,7 @@ import {-# SOURCE #-} GHC.Builtin.Types import {-# SOURCE #-} GHC.Core.DataCon ( DataCon, dataConExTyCoVars, dataConFieldLabels , dataConTyCon, dataConFullSig - , isUnboxedSumCon ) + , isUnboxedSumDataCon ) import GHC.Builtin.Uniques ( tyConRepNameUnique , dataConTyRepNameUnique ) @@ -1323,7 +1323,7 @@ tyConRepName_maybe (AlgTyCon { algTcParent = parent }) tyConRepName_maybe (FamilyTyCon { famTcFlav = DataFamilyTyCon rep_nm }) = Just rep_nm tyConRepName_maybe (PromotedDataCon { dataCon = dc, tcRepName = rep_nm }) - | isUnboxedSumCon dc -- see #13276 + | isUnboxedSumDataCon dc -- see #13276 = Nothing | otherwise = Just rep_nm ===================================== compiler/GHC/Core/Unfold.hs ===================================== @@ -889,7 +889,7 @@ conSize dc n_val_args | n_val_args == 0 = SizeIs 0 emptyBag 10 -- Like variables -- See Note [Unboxed tuple size and result discount] - | isUnboxedTupleCon dc = SizeIs 0 emptyBag 10 + | isUnboxedTupleDataCon dc = SizeIs 0 emptyBag 10 -- See Note [Constructor size and result discount] | otherwise = SizeIs 10 emptyBag 10 ===================================== compiler/GHC/CoreToByteCode.hs ===================================== @@ -648,7 +648,7 @@ schemeE d s p (AnnCase (_,scrut) _ _ []) = schemeE d s p scrut -- handle pairs with one void argument (e.g. state token) schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)]) - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc -- Convert -- case .... of x { (# V'd-thing, a #) -> ... } -- to @@ -667,7 +667,7 @@ schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)]) -- handle unit tuples schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)]) - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc , typePrimRep (idType bndr) `lengthAtMost` 1 = doCase d s p scrut bind1 [(DEFAULT, [], rhs)] (Just bndr) @@ -825,7 +825,7 @@ schemeT d s p app -- Case 2: Constructor application | Just con <- maybe_saturated_dcon - , isUnboxedTupleCon con + , isUnboxedTupleDataCon con = case args_r_to_l of [arg1,arg2] | isVAtom arg1 -> unboxedTupleReturn d s p arg2 @@ -1090,7 +1090,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-} my_discr (DataAlt dc, _, _) - | isUnboxedTupleCon dc || isUnboxedSumCon dc + | isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc = multiValException | otherwise = DiscrP (fromIntegral (dataConTag dc - fIRST_TAG)) ===================================== compiler/GHC/CoreToIface.hs ===================================== @@ -188,7 +188,7 @@ toIfaceTypeX fr (TyConApp tc tys) = IfaceTupleTy sort NotPromoted (toIfaceTcArgsX fr tc tys) | Just dc <- isPromotedDataCon_maybe tc - , isTupleDataCon dc + , isBoxedTupleDataCon dc , n_tys == 2*arity = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys)) ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -699,7 +699,7 @@ mkTopStgRhs dflags this_mod ccs bndr rhs , -- Dynamic StgConApps are updatable not (isDllConApp dflags this_mod con args) = -- CorePrep does this right, but just to make sure - ASSERT2( not (isUnboxedTupleCon con || isUnboxedSumCon con) + ASSERT2( not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) , ppr bndr $$ ppr con $$ ppr args) ( StgRhsCon dontCareCCS con args, ccs ) ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -172,7 +172,7 @@ pprConLike delta _prec cl args WcVarTerminated pref x -> parens . fcat . punctuate colon <$> mapM (pprPmVar appPrec) (toList pref ++ [x]) pprConLike _delta _prec (RealDataCon con) args - | isUnboxedTupleCon con + | isUnboxedTupleDataCon con , let hash_parens doc = text "(#" <+> doc <+> text "#)" = hash_parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args | isTupleDataCon con ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -164,7 +164,7 @@ lintStgRhs (StgRhsClosure _ _ _ binders expr) lintStgExpr expr lintStgRhs rhs@(StgRhsCon _ con args) = do - when (isUnboxedTupleCon con || isUnboxedSumCon con) $ do + when (isUnboxedTupleDataCon con || isUnboxedSumDataCon con) $ do opts <- getStgPprOpts addErrL (text "StgRhsCon is an unboxed tuple or sum application" $$ pprStgRhs opts rhs) @@ -182,7 +182,7 @@ lintStgExpr (StgApp fun args) = do lintStgExpr app@(StgConApp con args _arg_tys) = do -- unboxed sums should vanish during unarise lf <- getLintFlags - when (lf_unarised lf && isUnboxedSumCon con) $ do + when (lf_unarised lf && isUnboxedSumDataCon con) $ do opts <- getStgPprOpts addErrL (text "Unboxed sum after unarise:" $$ pprStgExpr opts app) ===================================== compiler/GHC/Stg/Unarise.hs ===================================== @@ -294,7 +294,7 @@ unariseRhs rho (StgRhsClosure ext ccs update_flag args expr) return (StgRhsClosure ext ccs update_flag args1 expr') unariseRhs rho (StgRhsCon ccs con args) - = ASSERT(not (isUnboxedTupleCon con || isUnboxedSumCon con)) + = ASSERT(not (isUnboxedTupleDataCon con || isUnboxedSumDataCon con)) return (StgRhsCon ccs con (unariseConArgs rho args)) -------------------------------------------------------------------------------- @@ -372,10 +372,10 @@ unariseExpr rho (StgTick tick e) -- Doesn't return void args. unariseMulti_maybe :: UnariseEnv -> DataCon -> [InStgArg] -> [Type] -> Maybe [OutStgArg] unariseMulti_maybe rho dc args ty_args - | isUnboxedTupleCon dc + | isUnboxedTupleDataCon dc = Just (unariseConArgs rho args) - | isUnboxedSumCon dc + | isUnboxedSumDataCon dc , let args1 = ASSERT(isSingleton args) (unariseConArgs rho args) = Just (mkUbxSum dc ty_args args1) ===================================== compiler/GHC/StgToCmm/DataCon.hs ===================================== @@ -354,7 +354,7 @@ bindConArgs :: AltCon -> LocalReg -> [NonVoid Id] -> FCode [LocalReg] -- binders args, assuming that we have just returned from a 'case' which -- found a con bindConArgs (DataAlt con) base args - = ASSERT(not (isUnboxedTupleCon con)) + = ASSERT(not (isUnboxedTupleDataCon con)) do profile <- getProfile platform <- getPlatform let (_, _, args_w_offsets) = mkVirtConstrOffsets profile (addIdReps args) ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -837,7 +837,7 @@ maybeAltHeapCheck (GcInAlts regs, ReturnedTo lret off) code = cgConApp :: DataCon -> [StgArg] -> FCode ReturnKind cgConApp con stg_args - | isUnboxedTupleCon con -- Unboxed tuple: assign and return + | isUnboxedTupleDataCon con -- Unboxed tuple: assign and return = do { arg_exprs <- getNonVoidArgAmodes stg_args ; tickyUnboxedTupleReturn (length arg_exprs) ; emitReturn arg_exprs } ===================================== compiler/GHC/Types/Id.hs ===================================== @@ -556,7 +556,7 @@ hasNoBinding :: Id -> Bool hasNoBinding id = case Var.idDetails id of PrimOpId _ -> True -- See Note [Eta expanding primops] in GHC.Builtin.PrimOps FCallId _ -> True - DataConWorkId dc -> isUnboxedTupleCon dc || isUnboxedSumCon dc + DataConWorkId dc -> isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc _ -> isCompulsoryUnfolding (idUnfolding id) -- See Note [Levity-polymorphic Ids] ===================================== testsuite/tests/ghci/scripts/T18644.script ===================================== @@ -0,0 +1,3 @@ +:set -XDataKinds -XUnboxedTuples +:kind! '(# #) +:kind! '() ===================================== testsuite/tests/ghci/scripts/T18644.stdout ===================================== @@ -0,0 +1,4 @@ +'(# #) :: (# #) += '(# #) +'() :: () += '() ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -315,3 +315,4 @@ test('T17403', normal, ghci_script, ['T17403.script']) test('T17431', normal, ghci_script, ['T17431.script']) test('T17549', normal, ghci_script, ['T17549.script']) test('T17669', [extra_run_opts('-fexternal-interpreter -fobject-code'), expect_broken(17669)], ghci_script, ['T17669.script']) +test('T18644', normal, ghci_script, ['T18644.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1e54439be3d38a1f972ac772cca7eec5e1519a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1e54439be3d38a1f972ac772cca7eec5e1519a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 20:56:27 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Sep 2020 16:56:27 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Don't rely on CLabel's Outputable instance in CmmToC Message-ID: <5f52a9fbd7ac6_80b3f84a029d754106675d9@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 100c3b48 by GHC GitLab CI at 2020-09-04T16:56:18-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 27633364 by Benjamin Maurer at 2020-09-04T16:56:19-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - c18e8d7d by Sylvain Henry at 2020-09-04T16:56:20-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 30 changed files: - aclocal.m4 - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/Types/Id.hs - configure.ac The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67076e23f335540017c0714663bbe3aa4b678d46...c18e8d7de4da7dc074ecae48de8b62f0fca3d854 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/67076e23f335540017c0714663bbe3aa4b678d46...c18e8d7de4da7dc074ecae48de8b62f0fca3d854 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 21:26:43 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 17:26:43 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] gitlab-ci: Bump Docker images Message-ID: <5f52b11326ee2_80b3f84862fa0b81067376e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: e6caec08 by Ben Gamari at 2020-09-04T17:26:03-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 5 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: 95d7e7a4908cf9bb15c7f55455405412a6d07bec # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +207,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -58,8 +58,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6caec084a0964f1c15ef51a1f6d7423de99102d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6caec084a0964f1c15ef51a1f6d7423de99102d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 21:29:57 2020 From: gitlab at gitlab.haskell.org (Richard Eisenberg) Date: Fri, 04 Sep 2020 17:29:57 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/no-iface-tuple-ty Message-ID: <5f52b1d52c9af_80b3f848648cca0106741da@gitlab.haskell.org.mail> Richard Eisenberg pushed new branch wip/no-iface-tuple-ty at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/no-iface-tuple-ty You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 21:37:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 17:37:34 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 3 commits: gitlab-ci: Bump Docker images Message-ID: <5f52b39e73c3e_80b3f846901bd3c106796db@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: e21e384f by Ben Gamari at 2020-09-04T17:36:23-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 32567fe2 by Ben Gamari at 2020-09-04T17:36:23-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - b2ba6a66 by Ben Gamari at 2020-09-04T17:37:25-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 7 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: 95d7e7a4908cf9bb15c7f55455405412a6d07bec # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +207,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6caec084a0964f1c15ef51a1f6d7423de99102d...b2ba6a66274d6c6772484481279d872f662b52f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6caec084a0964f1c15ef51a1f6d7423de99102d...b2ba6a66274d6c6772484481279d872f662b52f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 4 22:31:17 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Fri, 04 Sep 2020 18:31:17 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18656 Message-ID: <5f52c035cbb3a_80bd830b2810695575@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T18656 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18656 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 00:09:42 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Fri, 04 Sep 2020 20:09:42 -0400 Subject: [Git][ghc/ghc][wip/T18656] Make sure we can read past perf notes Message-ID: <5f52d74661b20_80b3f848675f05410706940@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18656 at Glasgow Haskell Compiler / GHC Commits: b9eeae56 by Krzysztof Gogolewski at 2020-09-05T02:09:14+02:00 Make sure we can read past perf notes See #18656. - - - - - 1 changed file: - testsuite/driver/perf_notes.py Changes: ===================================== testsuite/driver/perf_notes.py ===================================== @@ -113,7 +113,13 @@ MetricOracles = NamedTuple("MetricOracles", [("baseline", MetricBaselineOracle), def parse_perf_stat(stat_str: str) -> PerfStat: field_vals = stat_str.strip('\t').split('\t') - return PerfStat(*field_vals) # type: ignore + stat = PerfStat(*field_vals) # type: ignore + if stat.test_env.startswith('"') and stat.test_env.endswith('"'): + # Due to a bug, in historical data sometimes the test_env + # contains additional quotation marks (#18656). + # Remove them, so that we can refer to past data in a uniform fashion. + stat = stat._replace(test_env=stat.test_env[1:-1]) + return stat # Get all recorded (in a git note) metrics for a given commit. # Returns an empty array if the note is not found. @@ -645,6 +651,8 @@ def main() -> None: metrics = [test for test in metrics if test.stat.way == args.way] if args.test_env: + if '"' in args.test_env: + raise Exception('test_env should not contain quotation marks') metrics = [test for test in metrics if test.stat.test_env == args.test_env] if args.test_name: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9eeae56439b6f94777b75cceefe76c34530753d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b9eeae56439b6f94777b75cceefe76c34530753d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 00:20:49 2020 From: gitlab at gitlab.haskell.org (Krzysztof Gogolewski) Date: Fri, 04 Sep 2020 20:20:49 -0400 Subject: [Git][ghc/ghc][wip/T18656] Make sure we can read past perf notes Message-ID: <5f52d9e1bbbb5_80b3f849c43aa84107151a@gitlab.haskell.org.mail> Krzysztof Gogolewski pushed to branch wip/T18656 at Glasgow Haskell Compiler / GHC Commits: b8a9cff2 by Krzysztof Gogolewski at 2020-09-05T02:20:34+02:00 Make sure we can read past perf notes See #18656. - - - - - 1 changed file: - testsuite/driver/perf_notes.py Changes: ===================================== testsuite/driver/perf_notes.py ===================================== @@ -113,7 +113,13 @@ MetricOracles = NamedTuple("MetricOracles", [("baseline", MetricBaselineOracle), def parse_perf_stat(stat_str: str) -> PerfStat: field_vals = stat_str.strip('\t').split('\t') - return PerfStat(*field_vals) # type: ignore + stat = PerfStat(*field_vals) # type: ignore + if stat.test_env.startswith('"') and stat.test_env.endswith('"'): + # Due to a bug, in historical data sometimes the test_env + # contains additional quotation marks (#18656). + # Remove them, so that we can refer to past data in a uniform fashion. + stat = stat._replace(test_env=TestEnv(stat.test_env[1:-1])) + return stat # Get all recorded (in a git note) metrics for a given commit. # Returns an empty array if the note is not found. @@ -645,6 +651,8 @@ def main() -> None: metrics = [test for test in metrics if test.stat.way == args.way] if args.test_env: + if '"' in args.test_env: + raise Exception('test_env should not contain quotation marks') metrics = [test for test in metrics if test.stat.test_env == args.test_env] if args.test_name: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8a9cff2ce651c085c84980d3e709db2ecda8c3f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b8a9cff2ce651c085c84980d3e709db2ecda8c3f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 01:55:21 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 04 Sep 2020 21:55:21 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 3 commits: gitlab-ci: Bump Docker images Message-ID: <5f52f0095da3e_80b3f84869ed2d01071828a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 11b86790 by Ben Gamari at 2020-09-04T21:55:15-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - b6905f6f by Ben Gamari at 2020-09-04T21:55:15-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 7e39e23c by Ben Gamari at 2020-09-04T21:55:15-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 7 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: 8d0e7f321c78850f4aefe9f09a0a4b565ac36367 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +207,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b2ba6a66274d6c6772484481279d872f662b52f0...7e39e23ca883e2352080b32bdbd67d33be0fc3a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b2ba6a66274d6c6772484481279d872f662b52f0...7e39e23ca883e2352080b32bdbd67d33be0fc3a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 02:26:31 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Sep 2020 22:26:31 -0400 Subject: [Git][ghc/ghc][master] configure: Avoid hard-coded ld path on Windows Message-ID: <5f52f75727fdf_80b3f8495c2d5cc107197b6@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 7 changed files: - aclocal.m4 - compiler/GHC/Settings/IO.hs - configure.ac - hadrian/cfg/system.config.in - hadrian/src/Builder.hs - mk/config.mk.in - rules/build-package-way.mk Changes: ===================================== aclocal.m4 ===================================== @@ -532,6 +532,10 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="${mingw_bin_prefix}gcc.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="${mingw_bin_prefix}ld.exe" + # Overrides FIND_MERGE_OBJECTS in order to avoid hard-coding linker + # path on Windows (#18550). + SettingsMergeObjectsCommand="${SettingsLdCommand}" + SettingsMergeObjectsFlags="-r --oformat=pe-bigobj-x86-64" SettingsArCommand="${mingw_bin_prefix}ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}dllwrap.exe" @@ -545,6 +549,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" + SettingsMergeObjectsCommand="$(basename $MergeObjsCmd)" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$(basename $ArCmd)" SettingsDllWrapCommand="$(basename $DllWrapCmd)" SettingsWindresCommand="$(basename $WindresCmd)" @@ -554,6 +560,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$LdCmd" + SettingsMergeObjectsCommand="$MergeObjsCmd" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" if test -z "$DllWrapCmd" @@ -609,6 +617,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) AC_SUBST(SettingsLdFlags) + AC_SUBST(SettingsMergeObjectsCommand) + AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsDllWrapCommand) @@ -2625,7 +2635,7 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ ]) $CC -c -o conftest.a.o conftest.a.c || AC_MSG_ERROR([Failed to compile test]) - $SettingsMergeObjectsCommand $SettingsMergeObjectsFlags -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) + $MergeObjsCmd $MergeObjsArgs -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) $CC -c -o conftest.main.o conftest.main.c || AC_MSG_ERROR([Failed to compile test driver]) $CC conftest.ar.o conftest.main.o -o conftest || AC_MSG_ERROR([Failed to link test driver]) @@ -2645,33 +2655,30 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ # ------------------ # Find which linker to use to merge object files. # +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_REQUIRE([FIND_LD]) - if test -z "$SettingsMergeObjectsCommand"; then - SettingsMergeObjectsCommand="$LD" + if test -z "$MergeObjsCmd"; then + MergeObjsCmd="$LD" fi - if test -z "$SettingsMergeObjectsFlags"; then - SettingsMergeObjectsFlags="-r" + if test -z "$MergeObjsArgs"; then + MergeObjsArgs="-r" fi - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_NOTICE([$SettingsMergeObjectsCommand is broken due to binutils 22266, looking for another linker...]) - SettingsMergeObjectsCommand="" - AC_CHECK_TARGET_TOOL([SettingsMergeObjectsCommand], [ld]) - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + AC_MSG_NOTICE([$MergeObjsCmd is broken due to binutils 22266, looking for another linker...]) + MergeObjsCmd="" + AC_CHECK_TARGET_TOOL([MergeObjsCmd], [ld]) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the SettingsMergeObjectsCommand variable to a functional linker.]) + AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the MergeObjsCmd variable to a functional linker.]) fi fi - if test "$windows" = YES -a "$EnableDistroToolchain" = "NO" -a "$WORD_SIZE" = 64; then - SettingsMergeObjectsFlags="$SettingsMergeObjectsFlags --oformat=pe-bigobj-x86-64" - fi - - AC_SUBST(SettingsMergeObjectsCommand) - AC_SUBST(SettingsMergeObjectsFlags) + AC_SUBST([MergeObjsCmd]) + AC_SUBST([MergeObjsArgs]) ]) # FIND_PYTHON ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -137,7 +137,7 @@ initSettings top_dir = do as_args = map Option cc_args ld_prog = cc_prog ld_args = map Option (cc_args ++ words cc_link_args_str) - ld_r_prog <- getSetting "Merge objects command" + ld_r_prog <- getToolSetting "Merge objects command" ld_r_args <- getSetting "Merge objects flags" llvmTarget <- getSetting "LLVM target" ===================================== configure.ac ===================================== @@ -449,6 +449,8 @@ then NM="${mingwbin}nm.exe" RANLIB="${mingwbin}ranlib.exe" OBJDUMP="${mingwbin}objdump.exe" + MergeObjsCmd="$LD" + MergeObjsArgs="-r --oformat=pe-bigobj-x86-64" fp_prog_ar="${mingwbin}ar.exe" AC_PATH_PROG([Genlib],[genlib]) ===================================== hadrian/cfg/system.config.in ===================================== @@ -14,6 +14,7 @@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ nm = @NmCmd@ +merge-objects = @MergeObjsCmd@ objdump = @ObjdumpCmd@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ @@ -117,10 +118,10 @@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ -conf-merge-objects-args-stage0 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage1 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage2 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage3 = @SettingsMergeObjectsFlags@ +conf-merge-objects-args-stage0 = @MergeObjsArgs@ +conf-merge-objects-args-stage1 = @MergeObjsArgs@ +conf-merge-objects-args-stage2 = @MergeObjsArgs@ +conf-merge-objects-args-stage3 = @MergeObjsArgs@ # Settings: ===================================== hadrian/src/Builder.hs ===================================== @@ -317,7 +317,7 @@ systemBuilderPath builder = case builder of Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" Ld _ -> fromKey "ld" - MergeObjects _ -> fromKey "settings-merge-objects-command" + MergeObjects _ -> fromKey "merge-objects" Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" Nm -> fromKey "nm" ===================================== mk/config.mk.in ===================================== @@ -545,6 +545,16 @@ LD_STAGE1 = $(LD) LD_STAGE2 = $(LD) LD_STAGE3 = $(LD) +MERGE_OBJS_STAGE0 = @MergeObjsCmd@ +MERGE_OBJS_STAGE1 = @MergeObjsCmd@ +MERGE_OBJS_STAGE2 = @MergeObjsCmd@ +MERGE_OBJS_STAGE3 = @MergeObjsCmd@ + +MERGE_OBJS_STAGE0_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE1_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE2_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE3_FLAGS = @MergeObjsArgs@ + # Cross-compiling options # See Note [CrossCompiling vs Stage1Only] CrossCompiling = @CrossCompiling@ ===================================== rules/build-package-way.mk ===================================== @@ -107,6 +107,7 @@ endif endif # Build the GHCi library +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. ifneq "$(filter $3, v p)" "" $1_$2_$3_GHCI_LIB = $1/$2/build/HS$$($1_$2_COMPONENT_ID).$$($3_osuf) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" @@ -116,7 +117,7 @@ BINDIST_LIBS += $$($1_$2_$3_GHCI_LIB) endif endif $$($1_$2_$3_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) $$($1_$2_LD_SCRIPT) - $$(call cmd,SettingsMergeObjectsCommand) $(SettingsMergeObjectsFlags) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) + $$(call cmd,MERGE_OBJS_STAGE$4) $(MERGE_OBJS_STAGE$4_FLAGS) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" # Don't bother making ghci libs for bootstrapping packages ifneq "$4" "0" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07bdcac38c90e79db9e4327f87c5400630dfe74b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/07bdcac38c90e79db9e4327f87c5400630dfe74b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 02:27:09 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Sep 2020 22:27:09 -0400 Subject: [Git][ghc/ghc][master] Documented the as of yet undocumented '--print-*' GHC flags, Message-ID: <5f52f77d34717_80b3f848685bf48107217a4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4 changed files: - docs/users_guide/codegens.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/phases.rst - docs/users_guide/using.rst Changes: ===================================== docs/users_guide/codegens.rst ===================================== @@ -124,4 +124,5 @@ 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 --print-unregisterised`` (see :ghc-flag:`--print-unregisterised`) or ``ghc --info`` (see :ghc-flag:`--info`). ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -1,26 +1,6 @@ -#include --abi-hash --backpack ---print-booter-version ---print-build-platform ---print-c-compiler-flags ---print-c-compiler-link-flags ---print-debug-on ---print-global-package-db ---print-have-interpreter ---print-have-native-code-generator ---print-host-platform ---print-ld-flags ---print-leading-underscore ---print-object-splitting-supported ---print-project-git-commit-id ---print-project-version ---print-rts-ways ---print-stage ---print-support-smp ---print-tables-next-to-code ---print-target-platform ---print-unregisterised --show-packages -Onot -Wall-missed-specializations @@ -161,7 +141,6 @@ -rtsopts=none -rtsopts=some -smp --split-objs -syslib -this-component-id -ticky-LNE ===================================== docs/users_guide/phases.rst ===================================== @@ -675,6 +675,19 @@ Options affecting code generation and ``-dynhisuf`` are the counterparts of ``-o``, ``-osuf``, and ``-hisuf`` respectively, but applying to the dynamic compilation. +.. ghc-flag:: -split-objs + :shortdesc: Split generated object files into smaller files + :type: dynamic + :category: codegen + + When using this option, the object file is split into many smaller objects. + This feature is used when building libraries, so that a program statically + linked against the library will pull in less of the library. + + Since this uses platform specific techniques, it may not be available on + all target platforms. See the :ghc-flag:`--print-object-splitting-supported` + flag to check whether your GHC supports object splitting. + .. _options-linker: Options affecting linking ===================================== docs/users_guide/using.rst ===================================== @@ -420,6 +420,101 @@ The available mode flags are: Print GHC's numeric version number only. +.. ghc-flag:: --print-booter-version + :shortdesc: display bootstrap compiler version + :type: mode + :category: modes + + Print the numeric version of the GHC binary used to + bootstrap the build of this compiler. + +.. ghc-flag:: --print-build-platform + :shortdesc: display platform on which GHC was built + :type: mode + :category: modes + + Print the target string of the build platform, on which GHC was built, + as generated by GNU Autotools. + The format is ``cpu-manufacturer-operating_system-(kernel)``, e.g., + ``x86_64-unknown-linux``. + +.. ghc-flag:: --print-c-compiler-flags + :shortdesc: C compiler flags used to build GHC + :type: mode + :category: modes + + List the flags passed to the C compiler during GHC build. + +.. ghc-flag:: --print-c-compiler-link-flags + :shortdesc: C linker flags used to build GHC + :type: mode + :category: modes + + List the flags passed to the C compiler for the linking step + during GHC build. + +.. ghc-flag:: --print-debug-on + :shortdesc: print whether GHC was built with ``-DDEBUG`` + :type: mode + :category: modes + + Print ``True`` if GHC was built with ``-DDebug`` flag. + This enables assertions and extra debug code. + The flag can be set in ``GhcStage1HcOpts`` and/or ``GhcStage2HcOpts`` + and is automatically set for ``devel1`` and ``devel2`` build flavors. + +.. ghc-flag:: --print-global-package-db + :shortdesc: display GHC's global package database directory + :type: mode + :category: modes + + Print the path to GHC's global package database directory. + A package database stores details about installed packages as a directory + containing a file for each package. + This flag prints the path to the global database shipped with GHC, and + looks something like ``/usr/lib/ghc/package.conf.d`` on Unix. + There may be other package databases, e.g., the user package databse. + For more details see :ref:`package-databases`. + +.. ghc-flag:: --print-have-interpreter + :shortdesc: display whether GHC was built with interactive support + :type: mode + :category: modes + + Print ``YES`` if GHC was compiled to include the interpreter, ``NO`` otherwise. + If this GHC does not have the interpreter included, running it in interactive + mode (see :ghc-flag:`--interactive`) will throw an error. + This only pertains the use of GHC interactively, not any separate GHCi binaries + (see :ref:`ghci`). + +.. ghc-flag:: --print-have-native-code-generator + :shortdesc: display whether target platform has NCG support + :type: mode + :category: modes + + Print ``YES`` if native code generator supports the target platform, + ``NO`` otherwise. + (See :ref:`native-code-gen`) + +.. ghc-flag:: --print-host-platform + :shortdesc: display host platform of GHC + :type: mode + :category: modes + + Print the target string of the host platform, i.e., + the one on which GHC is supposed to run, as generated by GNU Autotools. + The format is ``cpu-manufacturer-operating_system-(kernel)``, e.g., + ``x86_64-unknown-linux``. + +.. ghc-flag:: --print-leading-underscore + :shortdesc: display use of leading underscores on symbol names + :type: mode + :category: modes + + Print ``YES`` if GHC was compiled to use symbols with leading underscores + in object files, ``NO`` otherwise. + This is usually atarget platform dependent. + .. ghc-flag:: --print-libdir :shortdesc: display GHC library directory :type: mode @@ -434,6 +529,106 @@ The available mode flags are: This is the value of ``$libdir`` in the package configuration file (see :ref:`packages`). +.. ghc-flag:: --print-ld-flags + :shortdesc: display linker flags used to compile GHC + :type: mode + :category: modes + + Print linke flags used to compile GHC. + +.. ghc-flag:: --print-object-splitting-supported + :shortdesc: display whether GHC supports object splitting + :type: mode + :category: modes + + Print ``YES`` if GHC was compiled with support for splitting generated + object files into smaller objects, ``NO`` otherwise. + This feature uses platform specific techniques and may not be available on + all platforms. + See :ghc-flag:`-split-objs` for details. + +.. ghc-flag:: --print-project-git-commit-id + :shortdesc: display Git commit id GHC is built from + :type: mode + :category: modes + + Print the Git commit id from which this GHC was built. + This can be used to trace the current binary back to a specific + revision, which is especially useful during development on GHC itself. + It is set by the configure script. + +.. ghc-flag:: --print-project-version + :shortdesc: display GHC version + :type: mode + :category: modes + + Print the version set in the configure script during build. + This is simply the GHC version. + +.. ghc-flag:: --print-rts-ways + :shortdesc: display which way RTS was built + :type: mode + :category: modes + + Packages, like the Runtime System, can be built in a number of ways: + - profiling - with profiling support + - dynamic - with dynamic linking + - logging - RTS event logging + - threaded - mulithreaded RTS + - debug - RTS with debug information + + Various combinations of these flavours are possible. + +.. ghc-flag:: --print-stage + :shortdesc: display ``stage`` number of GHC + :type: mode + :category: modes + + GHC is built using GHC itself and this build happens in stages, + which are numbered. + + - Stage 0 is the GHC you have installed. The "GHC you have installed" is also called "the bootstrap compiler". + - Stage 1 is the first GHC we build, using stage 0. Stage 1 is then used to build the packages. + - Stage 2 is the second GHC we build, using stage 1. This is the one we normally install when you say make install. + - Stage 3 is optional, but is sometimes built to test stage 2. + + Stage 1 does not support interactive execution (GHCi) and Template Haskell. + +.. ghc-flag:: --print-support-smp + :shortdesc: display whether GHC was compiled with SMP support + :type: mode + :category: modes + + Print ``YES`` if GHC was built with multiporcessor support, ``NO`` otherwise. + +.. ghc-flag:: --print-tables-next-to-code + :shortdesc: display whether GHC was compiled with ``--enable-tables-next-to-code`` + :type: mode + :category: modes + + Print ``YES`` if GHC was built with the flag ``--enable-tables-next-to-code``, ``NO`` otherwise. + This option is on by default, as it generates a more efficient code layout. + +.. ghc-flag:: --print-target-platform + :shortdesc: display target platform of GHC + :type: mode + :category: modes + + Print the target string of the target platform, i.e., + the one on which generated binaries will run, as generated by GNU Autotools. + The format is ``cpu-manufacturer-operating_system-(kernel)``, e.g., + ``x86_64-unknown-linux``. + +.. ghc-flag:: --print-unregisterised + :shortdesc: display whether this GHC was built in unregisterised mode + :type: mode + :category: modes + + Print ``YES`` if this GHC was built in unregisterised mode, ``NO`` otherwise. + "Unregisterised" means that GHC will disable most platform-specific tricks + and optimisations. Only the LLVM and C code generators will be available. + See :ref:`unreg` for more details. + .. _make-mode: Using ``ghc`` ``--make`` View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0be8e746b820662a09bf9e406bb7e86da3b548e6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0be8e746b820662a09bf9e406bb7e86da3b548e6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 02:27:50 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 04 Sep 2020 22:27:50 -0400 Subject: [Git][ghc/ghc][master] Move Hadrian's wiki pages in tree (fix #16165) Message-ID: <5f52f7a6ad669_80b3f846a3d3fa010730027@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 1 changed file: - + hadrian/doc/debugging.md Changes: ===================================== hadrian/doc/debugging.md ===================================== @@ -0,0 +1,104 @@ +## General tips on debugging Haskell + +https://wiki.haskell.org/Debugging + +## General tips on debugging shake + +http://shakebuild.com/debugging + +## Make-based old system + +1. `make show! VALUE=$(NAME)$` to check the value of variable `NAME` + +## Debugging Hadrian + +### General thoughts + +1. If a build command with some flags doesn't work, will that work on the Make-based old system? (Note that the directory structure is different, so we need to do some conversion) +2. If you delete something, but run top-level target again doesn't produce that, then it must be that this things is not correctly registered as tracked output + +### Verbosity + +Adding `-V`, `-VV`, `-VVV` can output more information from Shake and Hadrian for debugging purpose. For example, to print out the complete commands, you can use `-V`. + +### Common pitfalls + +- Out-of-date `UserSetting.hs`? (may cause compilation errors while building hadrian itself) +- Path: absolute? relative? platform-dependent? +- Missing environment variables? +- The upstream GHC/Cabal/... has updated + +### How to read exception message + +#### Type 1: `openFile: does not exist` + +**Example:** `hadrian: _build/stage1/ghc/GHCi/UI.o: openFile: does not exist (No such file or directory)` + +**Cause:** The build system tries to execute some *raw* I/O operation, which is not captured properly by shake build or any other handling mechanism. + +**Solution:** Use shake-provided or `Util`-provided I/O actions which can automatically make input files *dependencies*, and throw better exception (like below) when no rule for building these files exists. + +#### Type 2: `Error when running Shake build system:` + +Example: + +``` +Error when running Shake build system: +* OracleQ (PackageDataKey ("_build/stage1/libraries/unix/package-data.mk","COMPONENT_ID")) +* _build/stage1/libraries/unix/package-data.mk +* OracleQ (PackageDataKey ("_build/stage1/libraries/base/package-data.mk","COMPONENT_ID")) +* _build/stage1/libraries/base/package-data.mk +* OracleQ (PackageDataKey ("_build/stage1/libraries/ghc-prim/package-data.mk","COMPONENT_ID")) +* _build/stage1/libraries/ghc-prim/package-data.mk +* _build/stage1/libraries/ghc-prim/GHC/Prim.hs +* inplace/bin/genprimopcode +* OracleQ (PackageDataKey ("_build/stage0/utils/genprimopcode/package-data.mk","C_SRCS")) +* _build/stage0/utils/genprimopcode/package-data.mk +user error (Development.Shake.cmd, system command failed +Command: _build/stage0/utils/ghc-cabal/ghc-cabal configure utils/genprimopcode /Users/zz/Repos/ghc2/_build/stage0/utils/genprimopcode '' --with-ghc=/usr/local/bin/ghc --with-ghc-pkg=/usr/local/bin/ghc-pkg --package-db=_build/stage0/bootstrapping.conf --enable-library-vanilla --enable-library-for-ghci --disable-library-profiling --disable-shared --with-hscolour=/Users/zz/Library/Haskell/bin/HsColour '--configure-option=CFLAGS=-fno-stack-protector -I/Users/zz/Repos/ghc2/_build/generated' --configure-option=CPPFLAGS=-I_build/generated '--gcc-options=-fno-stack-protector -I/Users/zz/Repos/ghc2/_build/generated' --configure-option=--with-cc=/usr/bin/gcc --constraint 'Cabal == 2.0.0.0' --constraint 'binary == 0.8.4.1' --constraint 'ghc-boot == 8.3' --constraint 'ghc-boot-th == 8.3' --constraint 'ghci == 8.3' --constraint 'hoopl == 3.10.2.2' --constraint 'hpc == 0.6.0.3' --constraint 'template-haskell == 2.12.0.0' --constraint 'terminfo == 0.4.1.0' --constraint 'transformers == 0.5.2.0' --with-gcc=/usr/bin/gcc --with-ar=/usr/bin/ar --with-alex=/Users/zz/Library/Haskell/bin/alex --with-happy=/Users/zz/Library/Haskell/bin/happy -v0 --configure-option=--quiet --configure-option=--disable-option-checking +Exit code: 1 +Stderr: +ghc-cabal: ghc-pkg dump failed: dieVerbatim: user error (ghc-cabal: +'/usr/local/bin/ghc-pkg' exited with an error: +ghc-pkg: _build/stage0/bootstrapping.conf: getDirectoryContents: does not +exist (No such file or directory) +) +) +``` + +First, the list of `OracleQ`s is similar to a call trace. Each `OracleQ` line specifies the *target*, and lines without `OracleQ` after it specify dependencies. Each dependency is the *target* of the next level. + +The last level's target in the above example is `_build/stage0/utils/genprimopcode/package-data.mk`. Build system tries to build it with the command as shown in `Command` line (this is very useful -- since you can copy & paste and tweak with it directly when trying find the right rule). + +The error dumped after the `Command` line can help you identify the potential bug quickly. + +### Run some snippets + +Sometimes it is useful to run a few lines of code for debugging purpose, for example, print out the dependencies of `cabal`. The fastest way to do this is to modify the `Main.hs`, comment out the heavy-lifting rules, add insert the code you'd like to run. + +```haskell + Rules.Clean.cleanRules + Rules.Oracles.oracleRules + -- Rules.SourceDist.sourceDistRules + -- Rules.Selftest.selftestRules + -- Rules.Test.testRules + -- Rules.buildRules + -- Rules.topLevelTargets + rulesToTest +``` + +## How to enable stack trace + +first, build shake with profile support: + +``` +# inside shake source directory +cabal install --enable-profiling +``` + +``` +# for an example source file +cabal exec -- ghc -prof -fprof-auto examples/Main.hs +``` + +and a work-in-progress [traced fork of shake](https://github.com/monad-systems/shake/tree/traced) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4813486f8756fde7889b214e6e41ae63465f7ad7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4813486f8756fde7889b214e6e41ae63465f7ad7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 04:50:05 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 05 Sep 2020 00:50:05 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 3 commits: gitlab-ci: Bump Docker images Message-ID: <5f5318fd9ed4a_80b3f8468cba1d410733523@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 992057e5 by Ben Gamari at 2020-09-05T00:49:59-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - ea68461a by Ben Gamari at 2020-09-05T00:49:59-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - c6b291b1 by Ben Gamari at 2020-09-05T00:49:59-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 7 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: 12687d9ad19568f82cb31a47a7de5c82ca221da8 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +207,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e39e23ca883e2352080b32bdbd67d33be0fc3a8...c6b291b19e8a93b1b23942c26eedb232a7ab3224 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7e39e23ca883e2352080b32bdbd67d33be0fc3a8...c6b291b19e8a93b1b23942c26eedb232a7ab3224 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 13:26:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 05 Sep 2020 09:26:47 -0400 Subject: [Git][ghc/ghc][wip/T18587] 202 commits: Fix dead link to haskell prime discussion Message-ID: <5f539217e9bd2_80b3f847543036c10755348@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18587 at Glasgow Haskell Compiler / GHC Commits: 4c719460 by David Binder at 2020-07-22T20:17:35-04:00 Fix dead link to haskell prime discussion - - - - - f2f817e4 by BinderDavid at 2020-07-22T20:17:35-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 0bf8980e by Daniel Gröber at 2020-07-22T20:18:11-04:00 Remove length field from FastString - - - - - 1010c33b by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 8336ba78 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - 7484a9a4 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 5536ed28 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 5b8902e3 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - 5976a161 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 9ddf1614 by Daniel Gröber at 2020-07-22T20:18:11-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - e9491668 by Ben Gamari at 2020-07-22T20:18:46-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 9f3ff8fd by Andreas Klebinger at 2020-07-22T20:19:22-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - 0f17b930 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - bab4ec8f by Sylvain Henry at 2020-07-22T20:19:59-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - 8ea33edb by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused sGhcWithNativeCodeGen - - - - - e079bb72 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - 735f9d6b by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - f7cc4313 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace HscTarget with Backend They both have the same role and Backend name is more explicit. Metric Decrease: T3064 Update Haddock submodule - - - - - 15ce1804 by Andreas Klebinger at 2020-07-22T20:20:34-04:00 Deprecate -fdmd-tx-dict-sel. It's behaviour is now unconditionally enabled as it's slightly beneficial. There are almost no benchmarks which benefit from disabling it, so it's not worth the keep this configurable. This fixes #18429. - - - - - ff1b7710 by Sylvain Henry at 2020-07-22T20:21:11-04:00 Add test for #18064 It has been fixed by 0effc57d48ace6b719a9f4cbeac67c95ad55010b - - - - - cfa89149 by Krzysztof Gogolewski at 2020-07-22T20:21:48-04:00 Define type Void# = (# #) (#18441) There's one backwards compatibility issue: GHC.Prim no longer exports Void#, we now manually re-export it from GHC.Exts. - - - - - 02f40b0d by Sebastian Graf at 2020-07-22T20:22:23-04:00 Add regression test for #18478 !3392 backported !2993 to GHC 8.10.2 which most probably is responsible for fixing #18478, which triggered a pattern match checker performance regression in GHC 8.10.1 as first observed in #17977. - - - - - 7f44df1e by Sylvain Henry at 2020-07-22T20:23:00-04:00 Minor refactoring of Unit display * for consistency, try to always use UnitPprInfo to display units to users * remove some uses of `unitPackageIdString` as it doesn't show the component name and it uses String - - - - - dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - cdd0ff16 by Tamar Christina at 2020-07-24T18:12:23-04:00 winio: restore console cp on exit - - - - - c1f4f81d by Tamar Christina at 2020-07-24T18:13:00-04:00 winio: change memory allocation strategy and fix double free errors. - - - - - ba205046 by Simon Peyton Jones at 2020-07-24T18:13:35-04:00 Care with occCheckExpand in kind of occurrences Issue #18451 showed that we could get an infinite type, through over-use of occCheckExpand in the kind of an /occurrence/ of a type variable. See Note [Occurrence checking: look inside kinds] in GHC.Core.Type This patch fixes the problem by making occCheckExpand less eager to expand synonyms in kinds. It also improves pretty printing of kinds, by *not* suppressing the kind on a tyvar-binder like (a :: Const Type b) where type Const p q = p. Even though the kind of 'a' is Type, we don't want to suppress the kind ascription. Example: the error message for polykinds/T18451{a,b}. See GHC.Core.TyCo.Ppr Note [Suppressing * kinds]. - - - - - 02133353 by Zubin Duggal at 2020-07-25T00:44:30-04:00 Simplify XRec definition Change `Located X` usage to `XRec pass X` This increases the scope of the LPat experiment to almost all of GHC. Introduce UnXRec and MapXRec classes Fixes #17587 and #18408 Updates haddock submodule Co-authored-by: Philipp Krüger <philipp.krueger1 at gmail.com> - - - - - e443846b by Sylvain Henry at 2020-07-25T00:45:07-04:00 DynFlags: store printer in TraceBinIfaceReading We don't need to pass the whole DynFlags, just pass the logging function, if any. - - - - - 15b2b44f by Sylvain Henry at 2020-07-25T00:45:08-04:00 Rename GHC.Driver.Ways into GHC.Platform.Ways - - - - - 342a01af by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add GHC.Platform.Profile - - - - - 6333d739 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Put PlatformConstants into Platform - - - - - 9dfeca6c by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove platform constant wrappers Platform constant wrappers took a DynFlags parameter, hence implicitly used the target platform constants. We removed them to allow support for several platforms at once (#14335) and to avoid having to pass the full DynFlags to every function (#17957). Metric Decrease: T4801 - - - - - 73145d57 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove dead code in utils/derivConstants - - - - - 7721b923 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Move GHC.Platform into the compiler Previously it was in ghc-boot so that ghc-pkg could use it. However it wasn't necessary because ghc-pkg only uses a subset of it: reading target arch and OS from the settings file. This is now done via GHC.Platform.ArchOS (was called PlatformMini before). - - - - - 459afeb5 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Fix build systems - - - - - 9e2930c3 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Bump CountParserDeps - - - - - 6e2db34b by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add accessors to ArchOS - - - - - fc0f6fbc by Stefan Schulze Frielinghaus at 2020-07-25T00:45:45-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 - - - - - a7c4439a by Matthias Andreas Benkard at 2020-07-26T13:23:24-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. - - - - - da7269a4 by Ben Gamari at 2020-07-26T13:23:59-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. - - - - - f153a1d0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Update win32 output for parseTree - - - - - e91672f0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. - - - - - 9cbfe086 by Ben Gamari at 2020-07-26T13:23:59-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. - - - - - 8236925f by Tamar Christina at 2020-07-26T13:24:35-04:00 winio: remove dead argument to stg_newIOPortzh - - - - - ce0a1d67 by Tamar Christina at 2020-07-26T13:25:11-04:00 winio: fix detection of tty terminals - - - - - 52685cf7 by Tamar Christina at 2020-07-26T13:25:48-04:00 winio: update codeowners - - - - - aee45d9e by Vladislav Zavialov at 2020-07-27T07:06:56-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. - - - - - 667ab69e by leiftw at 2020-07-27T07:07:32-04:00 fix typo referring to non-existent `-ohidir` flag, should be `-hidir` I think - - - - - 6ff89c17 by Vladislav Zavialov at 2020-07-27T07:08:07-04:00 Refactor the parser a little * Create a dedicated production for type operators * Create a dedicated type for the UNPACK pragma * Remove an outdated part of Note [Parsing data constructors is hard] - - - - - aa054d32 by Ben Gamari at 2020-07-27T20:09:07-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. - - - - - 6da73bbf by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Add minimal test for #12492 - - - - - 47680cb7 by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Use allocate, not ALLOC_PRIM_P for unpackClosure# ALLOC_PRIM_P fails for large closures, by directly using allocate we can handle closures which are larger than the block size. Fixes #12492 - - - - - 3d345c96 by Simon Peyton Jones at 2020-07-27T20:10:19-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 - - - - - 57aca6bb by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. - - - - - 0a815cea by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. - - - - - 0bd60059 by Simon Peyton Jones at 2020-07-28T02:01:49-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 - - - - - 6ee07b49 by Sylvain Henry at 2020-07-28T02:02:27-04:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - f305bbfd by Peter Trommler at 2020-07-28T02:03:02-04:00 config: Fix Haskell platform constructor w/ params Fixes #18505 - - - - - 318bb17c by Oleg Grenrus at 2020-07-28T20:54:13-04:00 Fix typo in haddock Spotted by `vilpan` on `#haskell` - - - - - 39c89862 by Sergei Trofimovich at 2020-07-28T20:54:50-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b9a880fc by Felix Wiemuth at 2020-07-29T15:06:35-04:00 Fix typo - - - - - c59064b0 by Brandon Chinn at 2020-07-29T15:07:11-04:00 Add regression test for #16341 - - - - - a61411ca by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass dit_rep_tc_args to dsm_stock_gen_fn - - - - - a26498da by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass tc_args to gen_fn - - - - - 44b11bad by Brandon Chinn at 2020-07-29T15:07:11-04:00 Filter out unreachable constructors when deriving stock instances (#16431) - - - - - bbc51916 by Simon Peyton Jones at 2020-07-29T15:07:47-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 - - - - - e3db4b4c by Peter Trommler at 2020-07-29T15:08:22-04:00 configure: Fix build system on ARM - - - - - 96c31ea1 by Sylvain Henry at 2020-07-29T15:09:02-04:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - e1dc3d7b by Krzysztof Gogolewski at 2020-07-29T15:09:39-04:00 Fix validation errors (#18510) Test T2632 is a stage1 test that failed because of the Q => Quote change. The remaining tests did not use quotation and failed when the path contained a space. - - - - - 6c68a842 by John Ericson at 2020-07-30T07:11:02-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. - - - - - 502de556 by cgibbard at 2020-07-30T07:11:02-04:00 Add haddock comment for unfilteredEdges and move the note about drop_hs_boot_nodes into it. - - - - - 01c948eb by Ryan Scott at 2020-07-30T07:11:37-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. - - - - - d47324ce by Ryan Scott at 2020-07-30T07:12:16-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. - - - - - ebe2cf45 by Simon Peyton Jones at 2020-07-30T07:12:52-04:00 Remove an incorrect WARN in extendLocalRdrEnv I noticed this warning going off, and discovered that it's really fine. This small patch removes the warning, and docments what is going on. - - - - - 9f71f697 by Simon Peyton Jones at 2020-07-30T07:13:27-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d - - - - - 7c274cd5 by Sylvain Henry at 2020-07-30T22:54:48-04:00 Fix minimal imports dump for boot files (fix #18497) - - - - - 175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00 DynFlags: don't use sdocWithDynFlags in datacon ppr We don't need to use `sdocWithDynFlags` to know whether we should display linear types for datacon types, we already have `sdocLinearTypes` field in `SDocContext`. Moreover we want to remove `sdocWithDynFlags` (#10143, #17957)). - - - - - 380638a3 by Sylvain Henry at 2020-07-30T22:56:03-04:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - 56a7c193 by Sylvain Henry at 2020-07-31T19:32:09+02:00 Refactor CLabel pretty-printing Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove (#10143, #17957). It uses it to query the backend and the platform. This patch exposes Clabel ppr functions specialised for each backend so that backend code can directly use them. - - - - - 3b15dc3c by Sylvain Henry at 2020-07-31T19:32:09+02:00 DynFlags: don't use sdocWithDynFlags in GHC.CmmToAsm.Dwarf.Types - - - - - e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00 Test case for #17652 The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec - - - - - 22641742 by Ryan Scott at 2020-08-02T16:44:11-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. - - - - - f2d1accf by Leon Schoorl at 2020-08-02T16:44:47-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 - - - - - 947206f4 by Niklas Hambüchen at 2020-08-03T07:52:33+02:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. - - - - - ef2ae81a by Alex Biehl at 2020-08-03T07:52:33+02:00 Hardcode RTS includes to cope with unregistered builds - - - - - d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 5e12cd17 by Krzysztof Gogolewski at 2020-08-05T04:00:04-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. - - - - - 2bff2f87 by Ben Gamari at 2020-08-05T04:00:39-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. - - - - - 53ce0db5 by Ben Gamari at 2020-08-05T04:00:39-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. - - - - - eb7013c3 by Hécate at 2020-08-05T04:01:15-04:00 Remove all the unnecessary LANGUAGE pragmas - - - - - fbcb886d by Ryan Scott at 2020-08-05T04:01:51-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. - - - - - 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 99513c79 by Ben Gamari at 2020-09-05T09:26:44-04:00 rts/nonmoving: Add missing STM write barrier When updating a TRec for a TVar already part of a transaction we previously neglected to add the old value to the update remembered set. I suspect this was the cause of #18587. - - - - - 29 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - .gitlab/test-metrics.sh - CODEOWNERS - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/InfoTable.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Graph.hs - compiler/GHC/Cmm/Info.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/facfb76a0f0c3175b44a0c49f0b7573897b16f7f...99513c796700603da8524723ceca0f52937a9efa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/facfb76a0f0c3175b44a0c49f0b7573897b16f7f...99513c796700603da8524723ceca0f52937a9efa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 13:30:58 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 05 Sep 2020 09:30:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: configure: Avoid hard-coded ld path on Windows Message-ID: <5f53931257a1e_80b3f847543036c107603a5@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - a3662f63 by GHC GitLab CI at 2020-09-05T09:30:46-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 2c863773 by Ben Gamari at 2020-09-05T09:30:46-04:00 configure: Fix whitespace - - - - - 37933ab5 by Ben Gamari at 2020-09-05T09:30:47-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 57447690 by Ben Gamari at 2020-09-05T09:30:47-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - ea1c5571 by Ben Gamari at 2020-09-05T09:30:47-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9211dba5 by Ben Gamari at 2020-09-05T09:30:47-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 56bfc73d by Ben Gamari at 2020-09-05T09:30:47-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - d8a96a79 by Ben Gamari at 2020-09-05T09:30:47-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 2c5f7a35 by Ben Gamari at 2020-09-05T09:30:47-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - 21 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Settings/IO.hs - configure.ac - docs/users_guide/codegens.rst - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/phases.rst - docs/users_guide/using.rst - hadrian/cfg/system.config.in - + hadrian/doc/debugging.md - hadrian/src/Builder.hs - mk/config.mk.in - rts/linker/PEi386.c - rts/win32/IOManager.c - rts/win32/OSThreads.c - rts/win32/WorkQueue.c - rts/xxhash.c - rules/build-package-way.mk - − testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 - testsuite/tests/ghci/scripts/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -6,7 +6,7 @@ variables: # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. - WINDOWS_TOOLCHAIN_VERSION: 1 + WINDOWS_TOOLCHAIN_VERSION: 2 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 @@ -49,7 +49,7 @@ workflow: - if: $CI_COMMIT_TAG - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH == "wip/marge_bot_batch_merge_job"' - - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' + - if: '$CI_COMMIT_BRANCH =~ /ghc-[0-9]+\.[0-9]+/' - if: '$CI_PIPELINE_SOURCE == "web"' .nightly: &nightly @@ -67,7 +67,7 @@ workflow: when: always expire_in: 1 year rules: - - if: '$RELEASE == "yes"' + - if: '$RELEASE_JOB == "yes"' ############################################################ # Runner Tags @@ -896,9 +896,6 @@ validate-x86_64-windows-hadrian: cache: key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" -validate-x86_64-windows: - extends: .build-x86_64-windows-make - nightly-x86_64-windows: <<: *nightly extends: .build-x86_64-windows-make @@ -909,13 +906,13 @@ nightly-x86_64-windows: # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release - extends: validate-x86_64-windows + extends: .build-x86_64-windows-make variables: BUILD_FLAVOUR: "perf" # release-x86_64-windows-integer-simple: <<: *release - extends: validate-x86_64-windows + extends: .build-x86_64-windows-make variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" @@ -970,7 +967,7 @@ doc-tarball: image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" dependencies: - validate-x86_64-linux-deb9-debug - - validate-x86_64-windows + - validate-x86_64-windows-hadrian variables: LINUX_BINDIST: "ghc-x86_64-deb9-linux-debug.tar.xz" WINDOWS_BINDIST: "ghc-x86_64-mingw32.tar.xz" ===================================== .gitlab/ci.sh ===================================== @@ -26,9 +26,6 @@ LT_CYAN="1;36" WHITE="1;37" LT_GRAY="0;37" -export LANG=C.UTF-8 -export LC_ALL=C.UTF-8 - # GitLab Pipelines log section delimiters # https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 start_section() { @@ -60,6 +57,30 @@ function run() { TOP="$(pwd)" +function setup_locale() { + # BSD grep terminates early with -q, consequently locale -a will get a + # SIGPIPE and the pipeline will fail with pipefail. + shopt -o -u pipefail + if locale -a | grep -q C.UTF-8; then + # Debian + export LANG=C.UTF-8 + elif locale -a | grep -q C.utf8; then + # Fedora calls it this + export LANG=C.utf8 + elif locale -a | grep -q en_US.UTF-8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.UTF-8 + else + error "Failed to find usable locale" + info "Available locales:" + locale -a + fail "No usable locale, aborting..." + fi + info "Using locale $LANG..." + export LC_ALL=$LANG + shopt -o -s pipefail +} + function mingw_init() { case "$MSYSTEM" in MINGW32) @@ -423,6 +444,8 @@ function shell() { run $cmd } +setup_locale + # Determine Cabal data directory case "$(uname)" in MSYS_*|MINGW*) exe=".exe"; cabal_dir="$APPDATA/cabal" ;; ===================================== aclocal.m4 ===================================== @@ -532,6 +532,10 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="${mingw_bin_prefix}gcc.exe" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="${mingw_bin_prefix}ld.exe" + # Overrides FIND_MERGE_OBJECTS in order to avoid hard-coding linker + # path on Windows (#18550). + SettingsMergeObjectsCommand="${SettingsLdCommand}" + SettingsMergeObjectsFlags="-r --oformat=pe-bigobj-x86-64" SettingsArCommand="${mingw_bin_prefix}ar.exe" SettingsRanlibCommand="${mingw_bin_prefix}ranlib.exe" SettingsDllWrapCommand="${mingw_bin_prefix}dllwrap.exe" @@ -545,6 +549,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$(basename $HaskellCPPCmd)" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$(basename $LdCmd)" + SettingsMergeObjectsCommand="$(basename $MergeObjsCmd)" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$(basename $ArCmd)" SettingsDllWrapCommand="$(basename $DllWrapCmd)" SettingsWindresCommand="$(basename $WindresCmd)" @@ -554,6 +560,8 @@ AC_DEFUN([FP_SETTINGS], SettingsHaskellCPPCommand="$HaskellCPPCmd" SettingsHaskellCPPFlags="$HaskellCPPArgs" SettingsLdCommand="$LdCmd" + SettingsMergeObjectsCommand="$MergeObjsCmd" + SettingsMergeObjectsFlags="$MergeObjsArgs" SettingsArCommand="$ArCmd" SettingsRanlibCommand="$RanlibCmd" if test -z "$DllWrapCmd" @@ -609,6 +617,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsCCompilerSupportsNoPie) AC_SUBST(SettingsLdCommand) AC_SUBST(SettingsLdFlags) + AC_SUBST(SettingsMergeObjectsCommand) + AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) AC_SUBST(SettingsDllWrapCommand) @@ -1617,37 +1627,37 @@ AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) # --------------------- AC_DEFUN([FP_SETUP_PROJECT_VERSION], [ -if test "$RELEASE" = "NO"; then - AC_MSG_CHECKING([for GHC version date]) - if test -f VERSION_DATE; then - PACKAGE_VERSION=${PACKAGE_VERSION}.`cat VERSION_DATE` - AC_MSG_RESULT(given $PACKAGE_VERSION) - elif test -e .git; then - changequote(, )dnl - ver_posixtime=`git log -1 --pretty=format:%ct` - ver_date=`perl -MPOSIX -e "print strftime('%Y%m%d', gmtime($ver_posixtime));"` - if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else - changequote([, ])dnl - AC_MSG_ERROR([failed to detect version date: check that git and perl are in your path]) + if test "$RELEASE" = "NO"; then + AC_MSG_CHECKING([for GHC version date]) + if test -f VERSION_DATE; then + PACKAGE_VERSION=${PACKAGE_VERSION}.`cat VERSION_DATE` + AC_MSG_RESULT(given $PACKAGE_VERSION) + elif test -e .git; then + changequote(, )dnl + ver_posixtime=`git log -1 --pretty=format:%ct` + ver_date=`perl -MPOSIX -e "print strftime('%Y%m%d', gmtime($ver_posixtime));"` + if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else + changequote([, ])dnl + AC_MSG_ERROR([failed to detect version date: check that git and perl are in your path]) + fi + PACKAGE_VERSION=${PACKAGE_VERSION}.$ver_date + AC_MSG_RESULT(inferred $PACKAGE_VERSION) + elif test -f VERSION; then + PACKAGE_VERSION=`cat VERSION` + AC_MSG_RESULT(given $PACKAGE_VERSION) + else + AC_MSG_WARN([cannot determine snapshot version: no .git directory and no VERSION file]) + dnl We'd really rather this case didn't happen, but it might + dnl do (in particular, people using lndir trees may find that + dnl the build system can't find any other date). If it does + dnl happen, then we use the current date. + dnl This way we get some idea about how recent a build is. + dnl It also means that packages built for 2 different builds + dnl will probably use different version numbers, so things are + dnl less likely to go wrong. + PACKAGE_VERSION=${PACKAGE_VERSION}.`date +%Y%m%d` fi - PACKAGE_VERSION=${PACKAGE_VERSION}.$ver_date - AC_MSG_RESULT(inferred $PACKAGE_VERSION) - elif test -f VERSION; then - PACKAGE_VERSION=`cat VERSION` - AC_MSG_RESULT(given $PACKAGE_VERSION) - else - AC_MSG_WARN([cannot determine snapshot version: no .git directory and no VERSION file]) - dnl We'd really rather this case didn't happen, but it might - dnl do (in particular, people using lndir trees may find that - dnl the build system can't find any other date). If it does - dnl happen, then we use the current date. - dnl This way we get some idea about how recent a build is. - dnl It also means that packages built for 2 different builds - dnl will probably use different version numbers, so things are - dnl less likely to go wrong. - PACKAGE_VERSION=${PACKAGE_VERSION}.`date +%Y%m%d` fi -fi AC_MSG_CHECKING([for GHC Git commit id]) if test -e .git; then @@ -1666,54 +1676,54 @@ fi fi -# Some renamings -AC_SUBST([ProjectName], [$PACKAGE_NAME]) -AC_SUBST([ProjectVersion], [$PACKAGE_VERSION]) -AC_SUBST([ProjectGitCommitId], [$PACKAGE_GIT_COMMIT_ID]) + # Some renamings + AC_SUBST([ProjectName], [$PACKAGE_NAME]) + AC_SUBST([ProjectVersion], [$PACKAGE_VERSION]) + AC_SUBST([ProjectGitCommitId], [$PACKAGE_GIT_COMMIT_ID]) -# Split PACKAGE_VERSION into (possibly empty) parts -VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` -VERSION_TMP=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` -VERSION_MINOR=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` -ProjectPatchLevel=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` + # Split PACKAGE_VERSION into (possibly empty) parts + VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` + VERSION_TMP=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` + VERSION_MINOR=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` + ProjectPatchLevel=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` -# Calculate project version as an integer, using 2 digits for minor version -case $VERSION_MINOR in - ?) ProjectVersionInt=${VERSION_MAJOR}0${VERSION_MINOR} ;; - ??) ProjectVersionInt=${VERSION_MAJOR}${VERSION_MINOR} ;; - *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;; -esac -AC_SUBST([ProjectVersionInt]) + # Calculate project version as an integer, using 2 digits for minor version + case $VERSION_MINOR in + ?) ProjectVersionInt=${VERSION_MAJOR}0${VERSION_MINOR} ;; + ??) ProjectVersionInt=${VERSION_MAJOR}${VERSION_MINOR} ;; + *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;; + esac + AC_SUBST([ProjectVersionInt]) -# The project patchlevel is zero unless stated otherwise -test -z "$ProjectPatchLevel" && ProjectPatchLevel=0 + # The project patchlevel is zero unless stated otherwise + test -z "$ProjectPatchLevel" && ProjectPatchLevel=0 -# Save split version of ProjectPatchLevel -ProjectPatchLevel1=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1/'` -ProjectPatchLevel2=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3/'` + # Save split version of ProjectPatchLevel + ProjectPatchLevel1=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1/'` + ProjectPatchLevel2=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3/'` -AC_SUBST([ProjectPatchLevel1]) -AC_SUBST([ProjectPatchLevel2]) + AC_SUBST([ProjectPatchLevel1]) + AC_SUBST([ProjectPatchLevel2]) -# Remove dots from the patch level; this allows us to have versions like 6.4.1.20050508 -ProjectPatchLevel=`echo $ProjectPatchLevel | sed 's/\.//'` + # Remove dots from the patch level; this allows us to have versions like 6.4.1.20050508 + ProjectPatchLevel=`echo $ProjectPatchLevel | sed 's/\.//'` -AC_SUBST([ProjectPatchLevel]) + AC_SUBST([ProjectPatchLevel]) -# The version of the GHC package changes every day, since the -# patchlevel is the current date. We don't want to force -# recompilation of the entire compiler when this happens, so for -# GHC HEAD we omit the patchlevel from the package version number. -# -# The ProjectPatchLevel1 > 20000000 iff GHC HEAD. If it's for a stable -# release like 7.10.1 or for a release candidate such as 7.10.1.20141224 -# then we don't omit the patchlevel components. + # The version of the GHC package changes every day, since the + # patchlevel is the current date. We don't want to force + # recompilation of the entire compiler when this happens, so for + # GHC HEAD we omit the patchlevel from the package version number. + # + # The ProjectPatchLevel1 > 20000000 iff GHC HEAD. If it's for a stable + # release like 7.10.1 or for a release candidate such as 7.10.1.20141224 + # then we don't omit the patchlevel components. -ProjectVersionMunged="$ProjectVersion" -if test "$ProjectPatchLevel1" -gt 20000000; then - ProjectVersionMunged="${VERSION_MAJOR}.${VERSION_MINOR}" -fi -AC_SUBST([ProjectVersionMunged]) + ProjectVersionMunged="$ProjectVersion" + if test "$ProjectPatchLevel1" -gt 20000000; then + ProjectVersionMunged="${VERSION_MAJOR}.${VERSION_MINOR}" + fi + AC_SUBST([ProjectVersionMunged]) ])# FP_SETUP_PROJECT_VERSION # Check for a working timer_create(). We need a pretty detailed check @@ -2625,7 +2635,7 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ ]) $CC -c -o conftest.a.o conftest.a.c || AC_MSG_ERROR([Failed to compile test]) - $SettingsMergeObjectsCommand $SettingsMergeObjectsFlags -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) + $MergeObjsCmd $MergeObjsArgs -T conftest.t conftest.a.o -o conftest.ar.o || AC_MSG_ERROR([Failed to merge test object]) $CC -c -o conftest.main.o conftest.main.c || AC_MSG_ERROR([Failed to compile test driver]) $CC conftest.ar.o conftest.main.o -o conftest || AC_MSG_ERROR([Failed to link test driver]) @@ -2645,33 +2655,30 @@ AC_DEFUN([CHECK_FOR_GOLD_T22266],[ # ------------------ # Find which linker to use to merge object files. # +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. AC_DEFUN([FIND_MERGE_OBJECTS],[ AC_REQUIRE([FIND_LD]) - if test -z "$SettingsMergeObjectsCommand"; then - SettingsMergeObjectsCommand="$LD" + if test -z "$MergeObjsCmd"; then + MergeObjsCmd="$LD" fi - if test -z "$SettingsMergeObjectsFlags"; then - SettingsMergeObjectsFlags="-r" + if test -z "$MergeObjsArgs"; then + MergeObjsArgs="-r" fi - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_NOTICE([$SettingsMergeObjectsCommand is broken due to binutils 22266, looking for another linker...]) - SettingsMergeObjectsCommand="" - AC_CHECK_TARGET_TOOL([SettingsMergeObjectsCommand], [ld]) - CHECK_FOR_GOLD_T22266($SettingsMergeObjectsCommand) + AC_MSG_NOTICE([$MergeObjsCmd is broken due to binutils 22266, looking for another linker...]) + MergeObjsCmd="" + AC_CHECK_TARGET_TOOL([MergeObjsCmd], [ld]) + CHECK_FOR_GOLD_T22266($MergeObjsCmd) if test "$result" = "1"; then - AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the SettingsMergeObjectsCommand variable to a functional linker.]) + AC_MSG_ERROR([Linker is affected by binutils 22266 but couldn't find another unaffected linker. Please set the MergeObjsCmd variable to a functional linker.]) fi fi - if test "$windows" = YES -a "$EnableDistroToolchain" = "NO" -a "$WORD_SIZE" = 64; then - SettingsMergeObjectsFlags="$SettingsMergeObjectsFlags --oformat=pe-bigobj-x86-64" - fi - - AC_SUBST(SettingsMergeObjectsCommand) - AC_SUBST(SettingsMergeObjectsFlags) + AC_SUBST([MergeObjsCmd]) + AC_SUBST([MergeObjsArgs]) ]) # FIND_PYTHON ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -137,7 +137,7 @@ initSettings top_dir = do as_args = map Option cc_args ld_prog = cc_prog ld_args = map Option (cc_args ++ words cc_link_args_str) - ld_r_prog <- getSetting "Merge objects command" + ld_r_prog <- getToolSetting "Merge objects command" ld_r_args <- getSetting "Merge objects flags" llvmTarget <- getSetting "LLVM target" ===================================== configure.ac ===================================== @@ -449,6 +449,8 @@ then NM="${mingwbin}nm.exe" RANLIB="${mingwbin}ranlib.exe" OBJDUMP="${mingwbin}objdump.exe" + MergeObjsCmd="$LD" + MergeObjsArgs="-r --oformat=pe-bigobj-x86-64" fp_prog_ar="${mingwbin}ar.exe" AC_PATH_PROG([Genlib],[genlib]) ===================================== docs/users_guide/codegens.rst ===================================== @@ -124,4 +124,5 @@ 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 --print-unregisterised`` (see :ghc-flag:`--print-unregisterised`) or ``ghc --info`` (see :ghc-flag:`--info`). ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -1,26 +1,6 @@ -#include --abi-hash --backpack ---print-booter-version ---print-build-platform ---print-c-compiler-flags ---print-c-compiler-link-flags ---print-debug-on ---print-global-package-db ---print-have-interpreter ---print-have-native-code-generator ---print-host-platform ---print-ld-flags ---print-leading-underscore ---print-object-splitting-supported ---print-project-git-commit-id ---print-project-version ---print-rts-ways ---print-stage ---print-support-smp ---print-tables-next-to-code ---print-target-platform ---print-unregisterised --show-packages -Onot -Wall-missed-specializations @@ -161,7 +141,6 @@ -rtsopts=none -rtsopts=some -smp --split-objs -syslib -this-component-id -ticky-LNE ===================================== docs/users_guide/phases.rst ===================================== @@ -675,6 +675,19 @@ Options affecting code generation and ``-dynhisuf`` are the counterparts of ``-o``, ``-osuf``, and ``-hisuf`` respectively, but applying to the dynamic compilation. +.. ghc-flag:: -split-objs + :shortdesc: Split generated object files into smaller files + :type: dynamic + :category: codegen + + When using this option, the object file is split into many smaller objects. + This feature is used when building libraries, so that a program statically + linked against the library will pull in less of the library. + + Since this uses platform specific techniques, it may not be available on + all target platforms. See the :ghc-flag:`--print-object-splitting-supported` + flag to check whether your GHC supports object splitting. + .. _options-linker: Options affecting linking ===================================== docs/users_guide/using.rst ===================================== @@ -420,6 +420,101 @@ The available mode flags are: Print GHC's numeric version number only. +.. ghc-flag:: --print-booter-version + :shortdesc: display bootstrap compiler version + :type: mode + :category: modes + + Print the numeric version of the GHC binary used to + bootstrap the build of this compiler. + +.. ghc-flag:: --print-build-platform + :shortdesc: display platform on which GHC was built + :type: mode + :category: modes + + Print the target string of the build platform, on which GHC was built, + as generated by GNU Autotools. + The format is ``cpu-manufacturer-operating_system-(kernel)``, e.g., + ``x86_64-unknown-linux``. + +.. ghc-flag:: --print-c-compiler-flags + :shortdesc: C compiler flags used to build GHC + :type: mode + :category: modes + + List the flags passed to the C compiler during GHC build. + +.. ghc-flag:: --print-c-compiler-link-flags + :shortdesc: C linker flags used to build GHC + :type: mode + :category: modes + + List the flags passed to the C compiler for the linking step + during GHC build. + +.. ghc-flag:: --print-debug-on + :shortdesc: print whether GHC was built with ``-DDEBUG`` + :type: mode + :category: modes + + Print ``True`` if GHC was built with ``-DDebug`` flag. + This enables assertions and extra debug code. + The flag can be set in ``GhcStage1HcOpts`` and/or ``GhcStage2HcOpts`` + and is automatically set for ``devel1`` and ``devel2`` build flavors. + +.. ghc-flag:: --print-global-package-db + :shortdesc: display GHC's global package database directory + :type: mode + :category: modes + + Print the path to GHC's global package database directory. + A package database stores details about installed packages as a directory + containing a file for each package. + This flag prints the path to the global database shipped with GHC, and + looks something like ``/usr/lib/ghc/package.conf.d`` on Unix. + There may be other package databases, e.g., the user package databse. + For more details see :ref:`package-databases`. + +.. ghc-flag:: --print-have-interpreter + :shortdesc: display whether GHC was built with interactive support + :type: mode + :category: modes + + Print ``YES`` if GHC was compiled to include the interpreter, ``NO`` otherwise. + If this GHC does not have the interpreter included, running it in interactive + mode (see :ghc-flag:`--interactive`) will throw an error. + This only pertains the use of GHC interactively, not any separate GHCi binaries + (see :ref:`ghci`). + +.. ghc-flag:: --print-have-native-code-generator + :shortdesc: display whether target platform has NCG support + :type: mode + :category: modes + + Print ``YES`` if native code generator supports the target platform, + ``NO`` otherwise. + (See :ref:`native-code-gen`) + +.. ghc-flag:: --print-host-platform + :shortdesc: display host platform of GHC + :type: mode + :category: modes + + Print the target string of the host platform, i.e., + the one on which GHC is supposed to run, as generated by GNU Autotools. + The format is ``cpu-manufacturer-operating_system-(kernel)``, e.g., + ``x86_64-unknown-linux``. + +.. ghc-flag:: --print-leading-underscore + :shortdesc: display use of leading underscores on symbol names + :type: mode + :category: modes + + Print ``YES`` if GHC was compiled to use symbols with leading underscores + in object files, ``NO`` otherwise. + This is usually atarget platform dependent. + .. ghc-flag:: --print-libdir :shortdesc: display GHC library directory :type: mode @@ -434,6 +529,106 @@ The available mode flags are: This is the value of ``$libdir`` in the package configuration file (see :ref:`packages`). +.. ghc-flag:: --print-ld-flags + :shortdesc: display linker flags used to compile GHC + :type: mode + :category: modes + + Print linke flags used to compile GHC. + +.. ghc-flag:: --print-object-splitting-supported + :shortdesc: display whether GHC supports object splitting + :type: mode + :category: modes + + Print ``YES`` if GHC was compiled with support for splitting generated + object files into smaller objects, ``NO`` otherwise. + This feature uses platform specific techniques and may not be available on + all platforms. + See :ghc-flag:`-split-objs` for details. + +.. ghc-flag:: --print-project-git-commit-id + :shortdesc: display Git commit id GHC is built from + :type: mode + :category: modes + + Print the Git commit id from which this GHC was built. + This can be used to trace the current binary back to a specific + revision, which is especially useful during development on GHC itself. + It is set by the configure script. + +.. ghc-flag:: --print-project-version + :shortdesc: display GHC version + :type: mode + :category: modes + + Print the version set in the configure script during build. + This is simply the GHC version. + +.. ghc-flag:: --print-rts-ways + :shortdesc: display which way RTS was built + :type: mode + :category: modes + + Packages, like the Runtime System, can be built in a number of ways: + - profiling - with profiling support + - dynamic - with dynamic linking + - logging - RTS event logging + - threaded - mulithreaded RTS + - debug - RTS with debug information + + Various combinations of these flavours are possible. + +.. ghc-flag:: --print-stage + :shortdesc: display ``stage`` number of GHC + :type: mode + :category: modes + + GHC is built using GHC itself and this build happens in stages, + which are numbered. + + - Stage 0 is the GHC you have installed. The "GHC you have installed" is also called "the bootstrap compiler". + - Stage 1 is the first GHC we build, using stage 0. Stage 1 is then used to build the packages. + - Stage 2 is the second GHC we build, using stage 1. This is the one we normally install when you say make install. + - Stage 3 is optional, but is sometimes built to test stage 2. + + Stage 1 does not support interactive execution (GHCi) and Template Haskell. + +.. ghc-flag:: --print-support-smp + :shortdesc: display whether GHC was compiled with SMP support + :type: mode + :category: modes + + Print ``YES`` if GHC was built with multiporcessor support, ``NO`` otherwise. + +.. ghc-flag:: --print-tables-next-to-code + :shortdesc: display whether GHC was compiled with ``--enable-tables-next-to-code`` + :type: mode + :category: modes + + Print ``YES`` if GHC was built with the flag ``--enable-tables-next-to-code``, ``NO`` otherwise. + This option is on by default, as it generates a more efficient code layout. + +.. ghc-flag:: --print-target-platform + :shortdesc: display target platform of GHC + :type: mode + :category: modes + + Print the target string of the target platform, i.e., + the one on which generated binaries will run, as generated by GNU Autotools. + The format is ``cpu-manufacturer-operating_system-(kernel)``, e.g., + ``x86_64-unknown-linux``. + +.. ghc-flag:: --print-unregisterised + :shortdesc: display whether this GHC was built in unregisterised mode + :type: mode + :category: modes + + Print ``YES`` if this GHC was built in unregisterised mode, ``NO`` otherwise. + "Unregisterised" means that GHC will disable most platform-specific tricks + and optimisations. Only the LLVM and C code generators will be available. + See :ref:`unreg` for more details. + .. _make-mode: Using ``ghc`` ``--make`` ===================================== hadrian/cfg/system.config.in ===================================== @@ -14,6 +14,7 @@ hs-cpp = @HaskellCPPCmd@ ld = @LdCmd@ make = @MakeCmd@ nm = @NmCmd@ +merge-objects = @MergeObjsCmd@ objdump = @ObjdumpCmd@ ranlib = @REAL_RANLIB_CMD@ sphinx-build = @SPHINXBUILD@ @@ -117,10 +118,10 @@ conf-ld-linker-args-stage1 = @CONF_LD_LINKER_OPTS_STAGE1@ conf-ld-linker-args-stage2 = @CONF_LD_LINKER_OPTS_STAGE2@ conf-ld-linker-args-stage3 = @CONF_LD_LINKER_OPTS_STAGE3@ -conf-merge-objects-args-stage0 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage1 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage2 = @SettingsMergeObjectsFlags@ -conf-merge-objects-args-stage3 = @SettingsMergeObjectsFlags@ +conf-merge-objects-args-stage0 = @MergeObjsArgs@ +conf-merge-objects-args-stage1 = @MergeObjsArgs@ +conf-merge-objects-args-stage2 = @MergeObjsArgs@ +conf-merge-objects-args-stage3 = @MergeObjsArgs@ # Settings: ===================================== hadrian/doc/debugging.md ===================================== @@ -0,0 +1,104 @@ +## General tips on debugging Haskell + +https://wiki.haskell.org/Debugging + +## General tips on debugging shake + +http://shakebuild.com/debugging + +## Make-based old system + +1. `make show! VALUE=$(NAME)$` to check the value of variable `NAME` + +## Debugging Hadrian + +### General thoughts + +1. If a build command with some flags doesn't work, will that work on the Make-based old system? (Note that the directory structure is different, so we need to do some conversion) +2. If you delete something, but run top-level target again doesn't produce that, then it must be that this things is not correctly registered as tracked output + +### Verbosity + +Adding `-V`, `-VV`, `-VVV` can output more information from Shake and Hadrian for debugging purpose. For example, to print out the complete commands, you can use `-V`. + +### Common pitfalls + +- Out-of-date `UserSetting.hs`? (may cause compilation errors while building hadrian itself) +- Path: absolute? relative? platform-dependent? +- Missing environment variables? +- The upstream GHC/Cabal/... has updated + +### How to read exception message + +#### Type 1: `openFile: does not exist` + +**Example:** `hadrian: _build/stage1/ghc/GHCi/UI.o: openFile: does not exist (No such file or directory)` + +**Cause:** The build system tries to execute some *raw* I/O operation, which is not captured properly by shake build or any other handling mechanism. + +**Solution:** Use shake-provided or `Util`-provided I/O actions which can automatically make input files *dependencies*, and throw better exception (like below) when no rule for building these files exists. + +#### Type 2: `Error when running Shake build system:` + +Example: + +``` +Error when running Shake build system: +* OracleQ (PackageDataKey ("_build/stage1/libraries/unix/package-data.mk","COMPONENT_ID")) +* _build/stage1/libraries/unix/package-data.mk +* OracleQ (PackageDataKey ("_build/stage1/libraries/base/package-data.mk","COMPONENT_ID")) +* _build/stage1/libraries/base/package-data.mk +* OracleQ (PackageDataKey ("_build/stage1/libraries/ghc-prim/package-data.mk","COMPONENT_ID")) +* _build/stage1/libraries/ghc-prim/package-data.mk +* _build/stage1/libraries/ghc-prim/GHC/Prim.hs +* inplace/bin/genprimopcode +* OracleQ (PackageDataKey ("_build/stage0/utils/genprimopcode/package-data.mk","C_SRCS")) +* _build/stage0/utils/genprimopcode/package-data.mk +user error (Development.Shake.cmd, system command failed +Command: _build/stage0/utils/ghc-cabal/ghc-cabal configure utils/genprimopcode /Users/zz/Repos/ghc2/_build/stage0/utils/genprimopcode '' --with-ghc=/usr/local/bin/ghc --with-ghc-pkg=/usr/local/bin/ghc-pkg --package-db=_build/stage0/bootstrapping.conf --enable-library-vanilla --enable-library-for-ghci --disable-library-profiling --disable-shared --with-hscolour=/Users/zz/Library/Haskell/bin/HsColour '--configure-option=CFLAGS=-fno-stack-protector -I/Users/zz/Repos/ghc2/_build/generated' --configure-option=CPPFLAGS=-I_build/generated '--gcc-options=-fno-stack-protector -I/Users/zz/Repos/ghc2/_build/generated' --configure-option=--with-cc=/usr/bin/gcc --constraint 'Cabal == 2.0.0.0' --constraint 'binary == 0.8.4.1' --constraint 'ghc-boot == 8.3' --constraint 'ghc-boot-th == 8.3' --constraint 'ghci == 8.3' --constraint 'hoopl == 3.10.2.2' --constraint 'hpc == 0.6.0.3' --constraint 'template-haskell == 2.12.0.0' --constraint 'terminfo == 0.4.1.0' --constraint 'transformers == 0.5.2.0' --with-gcc=/usr/bin/gcc --with-ar=/usr/bin/ar --with-alex=/Users/zz/Library/Haskell/bin/alex --with-happy=/Users/zz/Library/Haskell/bin/happy -v0 --configure-option=--quiet --configure-option=--disable-option-checking +Exit code: 1 +Stderr: +ghc-cabal: ghc-pkg dump failed: dieVerbatim: user error (ghc-cabal: +'/usr/local/bin/ghc-pkg' exited with an error: +ghc-pkg: _build/stage0/bootstrapping.conf: getDirectoryContents: does not +exist (No such file or directory) +) +) +``` + +First, the list of `OracleQ`s is similar to a call trace. Each `OracleQ` line specifies the *target*, and lines without `OracleQ` after it specify dependencies. Each dependency is the *target* of the next level. + +The last level's target in the above example is `_build/stage0/utils/genprimopcode/package-data.mk`. Build system tries to build it with the command as shown in `Command` line (this is very useful -- since you can copy & paste and tweak with it directly when trying find the right rule). + +The error dumped after the `Command` line can help you identify the potential bug quickly. + +### Run some snippets + +Sometimes it is useful to run a few lines of code for debugging purpose, for example, print out the dependencies of `cabal`. The fastest way to do this is to modify the `Main.hs`, comment out the heavy-lifting rules, add insert the code you'd like to run. + +```haskell + Rules.Clean.cleanRules + Rules.Oracles.oracleRules + -- Rules.SourceDist.sourceDistRules + -- Rules.Selftest.selftestRules + -- Rules.Test.testRules + -- Rules.buildRules + -- Rules.topLevelTargets + rulesToTest +``` + +## How to enable stack trace + +first, build shake with profile support: + +``` +# inside shake source directory +cabal install --enable-profiling +``` + +``` +# for an example source file +cabal exec -- ghc -prof -fprof-auto examples/Main.hs +``` + +and a work-in-progress [traced fork of shake](https://github.com/monad-systems/shake/tree/traced) ===================================== hadrian/src/Builder.hs ===================================== @@ -317,7 +317,7 @@ systemBuilderPath builder = case builder of Happy -> fromKey "happy" HsCpp -> fromKey "hs-cpp" Ld _ -> fromKey "ld" - MergeObjects _ -> fromKey "settings-merge-objects-command" + MergeObjects _ -> fromKey "merge-objects" Make _ -> fromKey "make" Makeinfo -> fromKey "makeinfo" Nm -> fromKey "nm" ===================================== mk/config.mk.in ===================================== @@ -545,6 +545,16 @@ LD_STAGE1 = $(LD) LD_STAGE2 = $(LD) LD_STAGE3 = $(LD) +MERGE_OBJS_STAGE0 = @MergeObjsCmd@ +MERGE_OBJS_STAGE1 = @MergeObjsCmd@ +MERGE_OBJS_STAGE2 = @MergeObjsCmd@ +MERGE_OBJS_STAGE3 = @MergeObjsCmd@ + +MERGE_OBJS_STAGE0_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE1_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE2_FLAGS = @MergeObjsArgs@ +MERGE_OBJS_STAGE3_FLAGS = @MergeObjsArgs@ + # Cross-compiling options # See Note [CrossCompiling vs Stage1Only] CrossCompiling = @CrossCompiling@ ===================================== rts/linker/PEi386.c ===================================== @@ -735,7 +735,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) error: stgFree(buf); - char* errormsg = malloc(sizeof(char) * 80); + char* errormsg = stgMallocBytes(sizeof(char) * 80, "addDLL_PEi386"); snprintf(errormsg, 80, "addDLL: %" PATH_FMT " or dependencies not loaded. (Win32 error %lu)", dll_name, GetLastError()); /* LoadLibrary failed; return a ptr to the error msg. */ return errormsg; @@ -745,7 +745,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) { const unsigned int init_buf_size = 1024; unsigned int bufsize = init_buf_size; - wchar_t* result = malloc(sizeof(wchar_t) * bufsize); + wchar_t* result = stgMallocBytes(sizeof(wchar_t) * bufsize, "findSystemLibrary_PEi386"); DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL); if (wResult > bufsize) { @@ -755,7 +755,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) if (!wResult) { - free(result); + stgFree(result); return NULL; } @@ -773,7 +773,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) int bufsize = init_buf_size; // Make sure the path is an absolute path - WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* abs_path = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(1)"); DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL); if (!wResult){ IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError())); @@ -791,7 +791,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) else { warnMissingKBLibraryPaths(); - WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* str = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(2)"); wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); if (wResult > init_buf_size) { @@ -804,7 +804,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) } bufsize = wResult + 2 + pathlen(abs_path); - wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize); + wchar_t* newPath = stgMallocBytes(sizeof(wchar_t) * bufsize, "addLibrarySearchPath_PEi386(3)"); wcscpy(newPath, abs_path); wcscat(newPath, L";"); @@ -813,19 +813,19 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); } - free(newPath); - free(abs_path); + stgFree(newPath); + stgFree(abs_path); return str; } if (!result) { sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); - free(abs_path); + stgFree(abs_path); return NULL; } - free(abs_path); + stgFree(abs_path); return result; } ===================================== rts/win32/IOManager.c ===================================== @@ -265,7 +265,7 @@ IOWorkerProc(PVOID param) } // Free the WorkItem DeregisterWorkItem(iom,work); - free(work); + stgFree(work); } else { fprintf(stderr, "unable to fetch work; fatal.\n"); fflush(stderr); @@ -321,7 +321,7 @@ StartIOManager(void) wq = NewWorkQueue(); if ( !wq ) return false; - ioMan = (IOManagerState*)malloc(sizeof(IOManagerState)); + ioMan = (IOManagerState*)stgMallocBytes(sizeof(IOManagerState), "StartIOManager"); if (!ioMan) { FreeWorkQueue(wq); @@ -332,7 +332,7 @@ StartIOManager(void) hExit = CreateEvent ( NULL, true, false, NULL ); if ( !hExit ) { FreeWorkQueue(wq); - free(ioMan); + stgFree(ioMan); return false; } @@ -440,8 +440,7 @@ AddIORequest ( int fd, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return 0; + WorkItem* wItem = (WorkItem*)stgMallocBytse(sizeof(WorkItem), "AddIORequest"); unsigned int reqID = ioMan->requestID++; @@ -471,8 +470,7 @@ AddDelayRequest ( HsInt usecs, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return false; + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddDelayRequest"); unsigned int reqID = ioMan->requestID++; @@ -498,7 +496,7 @@ AddProcRequest ( void* proc, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddProcRequest"); if (!wItem) return false; unsigned int reqID = ioMan->requestID++; @@ -542,7 +540,7 @@ void ShutdownIOManager ( bool wait_threads ) barf("timeEndPeriod failed"); } - free(ioMan); + stgFree(ioMan); ioMan = NULL; } } ===================================== rts/win32/OSThreads.c ===================================== @@ -171,19 +171,19 @@ void freeThreadingResources (void) { if (cpuGroupCache) { - free(cpuGroupCache); + stgFree(cpuGroupCache); cpuGroupCache = NULL; } if (cpuGroupCumulativeCache) { - free(cpuGroupCumulativeCache); + stgFree(cpuGroupCumulativeCache); cpuGroupCumulativeCache = NULL; } if (cpuGroupDistCache) { - free(cpuGroupDistCache); + stgFree(cpuGroupDistCache); cpuGroupDistCache = NULL; } } @@ -240,7 +240,7 @@ getProcessorsDistribution (void) if (!cpuGroupDistCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupDistCache = malloc(n_groups * sizeof(uint8_t)); + cpuGroupDistCache = stgMallocBytes(n_groups * sizeof(uint8_t), "getProcessorsDistribution"); memset(cpuGroupDistCache, MAXIMUM_PROCESSORS, n_groups * sizeof(uint8_t)); for (int i = 0; i < n_groups; i++) @@ -265,7 +265,7 @@ getProcessorsCumulativeSum(void) if (!cpuGroupCumulativeCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupCumulativeCache = malloc(n_groups * sizeof(uint32_t)); + cpuGroupCumulativeCache = stgMallocBytes(n_groups * sizeof(uint32_t), "getProcessorsCumulativeSum"); memset(cpuGroupCumulativeCache, 0, n_groups * sizeof(uint32_t)); #if defined(x86_64_HOST_ARCH) @@ -306,7 +306,7 @@ createProcessorGroupMap (void) uint32_t numProcs = getNumberOfProcessors(); - cpuGroupCache = malloc(numProcs * sizeof(uint8_t)); + cpuGroupCache = stgMallocBytes(numProcs * sizeof(uint8_t), "createProcessorGroupMap"); /* For 32bit Windows and 64bit older than Windows 7, create a default mapping. */ memset(cpuGroupCache, 0, numProcs * sizeof(uint8_t)); @@ -386,7 +386,7 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M ASSERT(n_groups > 0); ASSERT(n_proc > 0); - mask = malloc(n_groups * sizeof(DWORD_PTR)); + mask = stgMallocBytes(n_groups * sizeof(DWORD_PTR), "setThreadAffinity"); memset(mask, 0, n_groups * sizeof(DWORD_PTR)); /* The mask for the individual groups are all 0 based @@ -422,14 +422,14 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M { r = SetThreadAffinityMask(hThread, mask[i]); if (r == 0) { - free(mask); + stgFree(mask); sysErrorBelch("SetThreadAffinity"); stg_exit(EXIT_FAILURE); } } } - free(mask); + stgFree(mask); } void ===================================== rts/win32/WorkQueue.c ===================================== @@ -41,12 +41,7 @@ newSemaphore(int initCount, int max) WorkQueue* NewWorkQueue() { - WorkQueue* wq = (WorkQueue*)malloc(sizeof(WorkQueue)); - - if (!wq) { - queue_error("NewWorkQueue", "malloc() failed"); - return wq; - } + WorkQueue* wq = (WorkQueue*)stgMallocBytes(sizeof(WorkQueue), "NewWorkQueue"); memset(wq, 0, sizeof *wq); ===================================== rts/xxhash.c ===================================== @@ -98,9 +98,11 @@ ***************************************/ /*! Modify the local functions below should you wish to use some other memory routines * for malloc(), free() */ -#include -static void* XXH_malloc(size_t s) { return malloc(s); } -static void XXH_free (void* p) { free(p); } +#include "Rts.h" +#include "RtsUtils.h" + +static void* XXH_malloc(size_t s) { return stgMallocBytes(s, "XXH_malloc"); } +static void XXH_free (void* p) { stgFree(p); } /*! and for memcpy() */ #include static void* XXH_memcpy(void* dest, const void* src, size_t size) { return memcpy(dest,src,size); } ===================================== rules/build-package-way.mk ===================================== @@ -107,6 +107,7 @@ endif endif # Build the GHCi library +# See Note [Merging object files for GHCi] in GHC.Driver.Pipeline. ifneq "$(filter $3, v p)" "" $1_$2_$3_GHCI_LIB = $1/$2/build/HS$$($1_$2_COMPONENT_ID).$$($3_osuf) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" @@ -116,7 +117,7 @@ BINDIST_LIBS += $$($1_$2_$3_GHCI_LIB) endif endif $$($1_$2_$3_GHCI_LIB) : $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) $$($1_$2_LD_SCRIPT) - $$(call cmd,SettingsMergeObjectsCommand) $(SettingsMergeObjectsFlags) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) + $$(call cmd,MERGE_OBJS_STAGE$4) $(MERGE_OBJS_STAGE$4_FLAGS) $$(if $$($1_$2_LD_SCRIPT),$$($1_$2_LD_SCRIPT_CMD) $$($1_$2_LD_SCRIPT)) -o $$@ $$(EXTRA_LD_LINKER_OPTS) $$($1_$2_$3_HS_OBJS) $$($1_$2_$3_CMM_OBJS) $$($1_$2_$3_C_OBJS) $$($1_$2_$3_S_OBJS) $$($1_$2_EXTRA_OBJS) ifeq "$$($1_$2_BUILD_GHCI_LIB)" "YES" # Don't bother making ghci libs for bootstrapping packages ifneq "$4" "0" ===================================== testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 deleted ===================================== @@ -1,160 +0,0 @@ -[(AnnotationTuple.hs:14:20, [p], Solo 1), - (AnnotationTuple.hs:14:23-29, [p], Solo "hello"), - (AnnotationTuple.hs:14:35-37, [p], Solo 6.5), - (AnnotationTuple.hs:14:39, [m], ()), - (AnnotationTuple.hs:14:41-52, [p], Solo [5, 5, 6, 7]), - (AnnotationTuple.hs:16:8, [p], Solo 1), - (AnnotationTuple.hs:16:11-17, [p], Solo "hello"), - (AnnotationTuple.hs:16:20-22, [p], Solo 6.5), - (AnnotationTuple.hs:16:24, [m], ()), - (AnnotationTuple.hs:16:25, [m], ()), - (AnnotationTuple.hs:16:26, [m], ()), (, [m], ())] -[ -(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1]) - -(AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6]) - -(AK AnnotationTuple.hs:1:1 AnnOpenC = [AnnotationTuple.hs:5:1]) - -(AK AnnotationTuple.hs:1:1 AnnWhere = [AnnotationTuple.hs:3:30-34]) - -(AK AnnotationTuple.hs:3:24-28 AnnCloseP = [AnnotationTuple.hs:3:28]) - -(AK AnnotationTuple.hs:3:24-28 AnnOpenP = [AnnotationTuple.hs:3:24]) - -(AK AnnotationTuple.hs:6:1-32 AnnAs = [AnnotationTuple.hs:6:28-29]) - -(AK AnnotationTuple.hs:6:1-32 AnnImport = [AnnotationTuple.hs:6:1-6]) - -(AK AnnotationTuple.hs:6:1-32 AnnQualified = [AnnotationTuple.hs:6:8-16]) - -(AK AnnotationTuple.hs:6:1-32 AnnSemi = [AnnotationTuple.hs:7:1]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnEqual = [AnnotationTuple.hs:8:5]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnFunId = [AnnotationTuple.hs:8:1-3]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnSemi = [AnnotationTuple.hs:13:1]) - -(AK AnnotationTuple.hs:(8,7)-(11,14) AnnIn = [AnnotationTuple.hs:11:7-8]) - -(AK AnnotationTuple.hs:(8,7)-(11,14) AnnLet = [AnnotationTuple.hs:8:7-9]) - -(AK AnnotationTuple.hs:9:9-13 AnnEqual = [AnnotationTuple.hs:9:11]) - -(AK AnnotationTuple.hs:9:9-13 AnnFunId = [AnnotationTuple.hs:9:9]) - -(AK AnnotationTuple.hs:9:9-13 AnnSemi = [AnnotationTuple.hs:10:9]) - -(AK AnnotationTuple.hs:10:9-13 AnnEqual = [AnnotationTuple.hs:10:11]) - -(AK AnnotationTuple.hs:10:9-13 AnnFunId = [AnnotationTuple.hs:10:9]) - -(AK AnnotationTuple.hs:11:10-14 AnnVal = [AnnotationTuple.hs:11:12]) - -(AK AnnotationTuple.hs:14:1-72 AnnEqual = [AnnotationTuple.hs:14:5]) - -(AK AnnotationTuple.hs:14:1-72 AnnFunId = [AnnotationTuple.hs:14:1-3]) - -(AK AnnotationTuple.hs:14:1-72 AnnSemi = [AnnotationTuple.hs:15:1]) - -(AK AnnotationTuple.hs:14:7-72 AnnVal = [AnnotationTuple.hs:14:13]) - -(AK AnnotationTuple.hs:14:19-53 AnnCloseP = [AnnotationTuple.hs:14:53]) - -(AK AnnotationTuple.hs:14:19-53 AnnOpenP = [AnnotationTuple.hs:14:19]) - -(AK AnnotationTuple.hs:14:20 AnnComma = [AnnotationTuple.hs:14:21]) - -(AK AnnotationTuple.hs:14:23-29 AnnComma = [AnnotationTuple.hs:14:33]) - -(AK AnnotationTuple.hs:14:35-37 AnnComma = [AnnotationTuple.hs:14:38]) - -(AK AnnotationTuple.hs:14:39 AnnComma = [AnnotationTuple.hs:14:39]) - -(AK AnnotationTuple.hs:14:41-52 AnnCloseS = [AnnotationTuple.hs:14:52]) - -(AK AnnotationTuple.hs:14:41-52 AnnOpenS = [AnnotationTuple.hs:14:41]) - -(AK AnnotationTuple.hs:14:42 AnnComma = [AnnotationTuple.hs:14:43]) - -(AK AnnotationTuple.hs:14:45 AnnComma = [AnnotationTuple.hs:14:46]) - -(AK AnnotationTuple.hs:14:48 AnnComma = [AnnotationTuple.hs:14:49]) - -(AK AnnotationTuple.hs:14:55-72 AnnCloseS = [AnnotationTuple.hs:14:72]) - -(AK AnnotationTuple.hs:14:55-72 AnnOpenS = [AnnotationTuple.hs:14:55]) - -(AK AnnotationTuple.hs:14:56-62 AnnComma = [AnnotationTuple.hs:14:63]) - -(AK AnnotationTuple.hs:14:61-62 AnnCloseP = [AnnotationTuple.hs:14:62]) - -(AK AnnotationTuple.hs:14:61-62 AnnOpenP = [AnnotationTuple.hs:14:61]) - -(AK AnnotationTuple.hs:16:1-41 AnnEqual = [AnnotationTuple.hs:16:5]) - -(AK AnnotationTuple.hs:16:1-41 AnnFunId = [AnnotationTuple.hs:16:1-3]) - -(AK AnnotationTuple.hs:16:1-41 AnnSemi = [AnnotationTuple.hs:17:1]) - -(AK AnnotationTuple.hs:16:7-27 AnnCloseP = [AnnotationTuple.hs:16:27]) - -(AK AnnotationTuple.hs:16:7-27 AnnOpenP = [AnnotationTuple.hs:16:7]) - -(AK AnnotationTuple.hs:16:8 AnnComma = [AnnotationTuple.hs:16:9]) - -(AK AnnotationTuple.hs:16:11-17 AnnComma = [AnnotationTuple.hs:16:18]) - -(AK AnnotationTuple.hs:16:20-22 AnnComma = [AnnotationTuple.hs:16:23]) - -(AK AnnotationTuple.hs:16:24 AnnComma = [AnnotationTuple.hs:16:24]) - -(AK AnnotationTuple.hs:16:25 AnnComma = [AnnotationTuple.hs:16:25]) - -(AK AnnotationTuple.hs:16:26 AnnComma = [AnnotationTuple.hs:16:26]) - -(AK AnnotationTuple.hs:16:33-41 AnnCloseP = [AnnotationTuple.hs:16:41]) - -(AK AnnotationTuple.hs:16:33-41 AnnOpenP = [AnnotationTuple.hs:16:33]) - -(AK AnnotationTuple.hs:16:39-40 AnnCloseP = [AnnotationTuple.hs:16:40]) - -(AK AnnotationTuple.hs:16:39-40 AnnOpenP = [AnnotationTuple.hs:16:39]) - -(AK AnnotationTuple.hs:18:1-28 AnnData = [AnnotationTuple.hs:18:1-4]) - -(AK AnnotationTuple.hs:18:1-28 AnnDcolon = [AnnotationTuple.hs:18:20-21]) - -(AK AnnotationTuple.hs:18:1-28 AnnFamily = [AnnotationTuple.hs:18:6-11]) - -(AK AnnotationTuple.hs:18:1-28 AnnSemi = [AnnotationTuple.hs:19:1]) - -(AK AnnotationTuple.hs:18:23 AnnRarrow = [AnnotationTuple.hs:18:25-26]) - -(AK AnnotationTuple.hs:18:23-28 AnnRarrow = [AnnotationTuple.hs:18:25-26]) - -(AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5]) - -(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1]) - -(AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7]) - -(AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7]) - -(AK AnnotationTuple.hs:21:9-24 AnnComma = [AnnotationTuple.hs:22:7]) - -(AK AnnotationTuple.hs:21:9-24 AnnLarrow = [AnnotationTuple.hs:21:16-17]) - -(AK AnnotationTuple.hs:22:9-25 AnnComma = [AnnotationTuple.hs:23:7]) - -(AK AnnotationTuple.hs:22:9-25 AnnLarrow = [AnnotationTuple.hs:22:16-17]) - -(AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) - -(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) - -(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) -] - -EOF: Just SrcSpanPoint ".\\AnnotationTuple.hs" 32 1 ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -141,8 +141,11 @@ test('T5979', normalise_slashes, normalise_version("transformers")], ghci_script, ['T5979.script']) -test('T5975a', [pre_cmd('touch föøbàr1.hs')], ghci_script, ['T5975a.script']) -test('T5975b', [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs')], +test('T5975a', + [pre_cmd('touch föøbàr1.hs'), when(opsys('mingw32'), expect_broken(7305))], + ghci_script, ['T5975a.script']) +test('T5975b', + [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs'), when(opsys('mingw32'), expect_broken(7305))], ghci_script, ['T5975b.script']) test('T6027ghci', normal, ghci_script, ['T6027ghci.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c18e8d7de4da7dc074ecae48de8b62f0fca3d854...2c5f7a35103533495d26d80df30f91f62d6e2650 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c18e8d7de4da7dc074ecae48de8b62f0fca3d854...2c5f7a35103533495d26d80df30f91f62d6e2650 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 13:28:24 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 05 Sep 2020 09:28:24 -0400 Subject: [Git][ghc/ghc][wip/T18587] rts/nonmoving: Add missing STM write barrier Message-ID: <5f53927837e77_80b111e6bd810755777@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18587 at Glasgow Haskell Compiler / GHC Commits: 2a9063e9 by Ben Gamari at 2020-09-05T09:28:18-04:00 rts/nonmoving: Add missing STM write barrier When updating a TRec for a TVar already part of a transaction we previously neglected to add the old value to the update remembered set. I suspect this was the cause of #18587. - - - - - 1 changed file: - rts/STM.c Changes: ===================================== rts/STM.c ===================================== @@ -1342,6 +1342,9 @@ void stmWriteTVar(Capability *cap, if (entry != NULL) { if (entry_in == trec) { // Entry found in our trec + IF_NONMOVING_WRITE_BARRIER_ENABLED { + updateRemembSetPushClosure(&cap, (StgClosure *) entry->new_value); + } entry -> new_value = new_value; } else { // Entry found in another trec View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a9063e9b30f43d2e2767bcdec702b020c6bd11a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2a9063e9b30f43d2e2767bcdec702b020c6bd11a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 14:13:48 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sat, 05 Sep 2020 10:13:48 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 10 commits: Don't rely on CLabel's Outputable instance in CmmToC Message-ID: <5f539d1cebed4_80b8a987f81076439b@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 2412c755 by Ben Gamari at 2020-09-05T10:13:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - ab228eb9 by Ben Gamari at 2020-09-05T10:13:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 5603e233 by Ben Gamari at 2020-09-05T10:13:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/Core/Unfold.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/CoreToIface.hs - compiler/GHC/CoreToStg.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToCmm/DataCon.hs - compiler/GHC/StgToCmm/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6b291b19e8a93b1b23942c26eedb232a7ab3224...5603e233a26206080f3199e1e074f112a75f59bd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c6b291b19e8a93b1b23942c26eedb232a7ab3224...5603e233a26206080f3199e1e074f112a75f59bd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 18:50:58 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 05 Sep 2020 14:50:58 -0400 Subject: [Git][ghc/ghc][master] rts: Consistently use stgMallocBytes instead of malloc Message-ID: <5f53de124d850_80b3f8468ce28141076999d@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 5 changed files: - rts/linker/PEi386.c - rts/win32/IOManager.c - rts/win32/OSThreads.c - rts/win32/WorkQueue.c - rts/xxhash.c Changes: ===================================== rts/linker/PEi386.c ===================================== @@ -735,7 +735,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) error: stgFree(buf); - char* errormsg = malloc(sizeof(char) * 80); + char* errormsg = stgMallocBytes(sizeof(char) * 80, "addDLL_PEi386"); snprintf(errormsg, 80, "addDLL: %" PATH_FMT " or dependencies not loaded. (Win32 error %lu)", dll_name, GetLastError()); /* LoadLibrary failed; return a ptr to the error msg. */ return errormsg; @@ -745,7 +745,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) { const unsigned int init_buf_size = 1024; unsigned int bufsize = init_buf_size; - wchar_t* result = malloc(sizeof(wchar_t) * bufsize); + wchar_t* result = stgMallocBytes(sizeof(wchar_t) * bufsize, "findSystemLibrary_PEi386"); DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL); if (wResult > bufsize) { @@ -755,7 +755,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) if (!wResult) { - free(result); + stgFree(result); return NULL; } @@ -773,7 +773,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) int bufsize = init_buf_size; // Make sure the path is an absolute path - WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* abs_path = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(1)"); DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL); if (!wResult){ IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError())); @@ -791,7 +791,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) else { warnMissingKBLibraryPaths(); - WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* str = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(2)"); wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); if (wResult > init_buf_size) { @@ -804,7 +804,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) } bufsize = wResult + 2 + pathlen(abs_path); - wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize); + wchar_t* newPath = stgMallocBytes(sizeof(wchar_t) * bufsize, "addLibrarySearchPath_PEi386(3)"); wcscpy(newPath, abs_path); wcscat(newPath, L";"); @@ -813,19 +813,19 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); } - free(newPath); - free(abs_path); + stgFree(newPath); + stgFree(abs_path); return str; } if (!result) { sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); - free(abs_path); + stgFree(abs_path); return NULL; } - free(abs_path); + stgFree(abs_path); return result; } ===================================== rts/win32/IOManager.c ===================================== @@ -265,7 +265,7 @@ IOWorkerProc(PVOID param) } // Free the WorkItem DeregisterWorkItem(iom,work); - free(work); + stgFree(work); } else { fprintf(stderr, "unable to fetch work; fatal.\n"); fflush(stderr); @@ -321,7 +321,7 @@ StartIOManager(void) wq = NewWorkQueue(); if ( !wq ) return false; - ioMan = (IOManagerState*)malloc(sizeof(IOManagerState)); + ioMan = (IOManagerState*)stgMallocBytes(sizeof(IOManagerState), "StartIOManager"); if (!ioMan) { FreeWorkQueue(wq); @@ -332,7 +332,7 @@ StartIOManager(void) hExit = CreateEvent ( NULL, true, false, NULL ); if ( !hExit ) { FreeWorkQueue(wq); - free(ioMan); + stgFree(ioMan); return false; } @@ -440,8 +440,7 @@ AddIORequest ( int fd, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return 0; + WorkItem* wItem = (WorkItem*)stgMallocBytse(sizeof(WorkItem), "AddIORequest"); unsigned int reqID = ioMan->requestID++; @@ -471,8 +470,7 @@ AddDelayRequest ( HsInt usecs, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return false; + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddDelayRequest"); unsigned int reqID = ioMan->requestID++; @@ -498,7 +496,7 @@ AddProcRequest ( void* proc, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddProcRequest"); if (!wItem) return false; unsigned int reqID = ioMan->requestID++; @@ -542,7 +540,7 @@ void ShutdownIOManager ( bool wait_threads ) barf("timeEndPeriod failed"); } - free(ioMan); + stgFree(ioMan); ioMan = NULL; } } ===================================== rts/win32/OSThreads.c ===================================== @@ -171,19 +171,19 @@ void freeThreadingResources (void) { if (cpuGroupCache) { - free(cpuGroupCache); + stgFree(cpuGroupCache); cpuGroupCache = NULL; } if (cpuGroupCumulativeCache) { - free(cpuGroupCumulativeCache); + stgFree(cpuGroupCumulativeCache); cpuGroupCumulativeCache = NULL; } if (cpuGroupDistCache) { - free(cpuGroupDistCache); + stgFree(cpuGroupDistCache); cpuGroupDistCache = NULL; } } @@ -240,7 +240,7 @@ getProcessorsDistribution (void) if (!cpuGroupDistCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupDistCache = malloc(n_groups * sizeof(uint8_t)); + cpuGroupDistCache = stgMallocBytes(n_groups * sizeof(uint8_t), "getProcessorsDistribution"); memset(cpuGroupDistCache, MAXIMUM_PROCESSORS, n_groups * sizeof(uint8_t)); for (int i = 0; i < n_groups; i++) @@ -265,7 +265,7 @@ getProcessorsCumulativeSum(void) if (!cpuGroupCumulativeCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupCumulativeCache = malloc(n_groups * sizeof(uint32_t)); + cpuGroupCumulativeCache = stgMallocBytes(n_groups * sizeof(uint32_t), "getProcessorsCumulativeSum"); memset(cpuGroupCumulativeCache, 0, n_groups * sizeof(uint32_t)); #if defined(x86_64_HOST_ARCH) @@ -306,7 +306,7 @@ createProcessorGroupMap (void) uint32_t numProcs = getNumberOfProcessors(); - cpuGroupCache = malloc(numProcs * sizeof(uint8_t)); + cpuGroupCache = stgMallocBytes(numProcs * sizeof(uint8_t), "createProcessorGroupMap"); /* For 32bit Windows and 64bit older than Windows 7, create a default mapping. */ memset(cpuGroupCache, 0, numProcs * sizeof(uint8_t)); @@ -386,7 +386,7 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M ASSERT(n_groups > 0); ASSERT(n_proc > 0); - mask = malloc(n_groups * sizeof(DWORD_PTR)); + mask = stgMallocBytes(n_groups * sizeof(DWORD_PTR), "setThreadAffinity"); memset(mask, 0, n_groups * sizeof(DWORD_PTR)); /* The mask for the individual groups are all 0 based @@ -422,14 +422,14 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M { r = SetThreadAffinityMask(hThread, mask[i]); if (r == 0) { - free(mask); + stgFree(mask); sysErrorBelch("SetThreadAffinity"); stg_exit(EXIT_FAILURE); } } } - free(mask); + stgFree(mask); } void ===================================== rts/win32/WorkQueue.c ===================================== @@ -41,12 +41,7 @@ newSemaphore(int initCount, int max) WorkQueue* NewWorkQueue() { - WorkQueue* wq = (WorkQueue*)malloc(sizeof(WorkQueue)); - - if (!wq) { - queue_error("NewWorkQueue", "malloc() failed"); - return wq; - } + WorkQueue* wq = (WorkQueue*)stgMallocBytes(sizeof(WorkQueue), "NewWorkQueue"); memset(wq, 0, sizeof *wq); ===================================== rts/xxhash.c ===================================== @@ -98,9 +98,11 @@ ***************************************/ /*! Modify the local functions below should you wish to use some other memory routines * for malloc(), free() */ -#include -static void* XXH_malloc(size_t s) { return malloc(s); } -static void XXH_free (void* p) { free(p); } +#include "Rts.h" +#include "RtsUtils.h" + +static void* XXH_malloc(size_t s) { return stgMallocBytes(s, "XXH_malloc"); } +static void XXH_free (void* p) { stgFree(p); } /*! and for memcpy() */ #include static void* XXH_memcpy(void* dest, const void* src, size_t size) { return memcpy(dest,src,size); } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7980ae23696f2406c65ee498155b26c09d3d4394 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7980ae23696f2406c65ee498155b26c09d3d4394 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sat Sep 5 18:51:35 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Sat, 05 Sep 2020 14:51:35 -0400 Subject: [Git][ghc/ghc][master] 8 commits: configure: Fix whitespace Message-ID: <5f53de3731847_80b3f847c273edc107753a0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - 5 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - − testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 - testsuite/tests/ghci/scripts/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -6,7 +6,7 @@ variables: # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. - WINDOWS_TOOLCHAIN_VERSION: 1 + WINDOWS_TOOLCHAIN_VERSION: 2 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 @@ -49,7 +49,7 @@ workflow: - if: $CI_COMMIT_TAG - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH == "wip/marge_bot_batch_merge_job"' - - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' + - if: '$CI_COMMIT_BRANCH =~ /ghc-[0-9]+\.[0-9]+/' - if: '$CI_PIPELINE_SOURCE == "web"' .nightly: &nightly @@ -67,7 +67,7 @@ workflow: when: always expire_in: 1 year rules: - - if: '$RELEASE == "yes"' + - if: '$RELEASE_JOB == "yes"' ############################################################ # Runner Tags @@ -896,9 +896,6 @@ validate-x86_64-windows-hadrian: cache: key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" -validate-x86_64-windows: - extends: .build-x86_64-windows-make - nightly-x86_64-windows: <<: *nightly extends: .build-x86_64-windows-make @@ -909,13 +906,13 @@ nightly-x86_64-windows: # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release - extends: validate-x86_64-windows + extends: .build-x86_64-windows-make variables: BUILD_FLAVOUR: "perf" # release-x86_64-windows-integer-simple: <<: *release - extends: validate-x86_64-windows + extends: .build-x86_64-windows-make variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" @@ -970,7 +967,7 @@ doc-tarball: image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" dependencies: - validate-x86_64-linux-deb9-debug - - validate-x86_64-windows + - validate-x86_64-windows-hadrian variables: LINUX_BINDIST: "ghc-x86_64-deb9-linux-debug.tar.xz" WINDOWS_BINDIST: "ghc-x86_64-mingw32.tar.xz" ===================================== .gitlab/ci.sh ===================================== @@ -26,9 +26,6 @@ LT_CYAN="1;36" WHITE="1;37" LT_GRAY="0;37" -export LANG=C.UTF-8 -export LC_ALL=C.UTF-8 - # GitLab Pipelines log section delimiters # https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 start_section() { @@ -60,6 +57,30 @@ function run() { TOP="$(pwd)" +function setup_locale() { + # BSD grep terminates early with -q, consequently locale -a will get a + # SIGPIPE and the pipeline will fail with pipefail. + shopt -o -u pipefail + if locale -a | grep -q C.UTF-8; then + # Debian + export LANG=C.UTF-8 + elif locale -a | grep -q C.utf8; then + # Fedora calls it this + export LANG=C.utf8 + elif locale -a | grep -q en_US.UTF-8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.UTF-8 + else + error "Failed to find usable locale" + info "Available locales:" + locale -a + fail "No usable locale, aborting..." + fi + info "Using locale $LANG..." + export LC_ALL=$LANG + shopt -o -s pipefail +} + function mingw_init() { case "$MSYSTEM" in MINGW32) @@ -423,6 +444,8 @@ function shell() { run $cmd } +setup_locale + # Determine Cabal data directory case "$(uname)" in MSYS_*|MINGW*) exe=".exe"; cabal_dir="$APPDATA/cabal" ;; ===================================== aclocal.m4 ===================================== @@ -1627,37 +1627,37 @@ AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) # --------------------- AC_DEFUN([FP_SETUP_PROJECT_VERSION], [ -if test "$RELEASE" = "NO"; then - AC_MSG_CHECKING([for GHC version date]) - if test -f VERSION_DATE; then - PACKAGE_VERSION=${PACKAGE_VERSION}.`cat VERSION_DATE` - AC_MSG_RESULT(given $PACKAGE_VERSION) - elif test -e .git; then - changequote(, )dnl - ver_posixtime=`git log -1 --pretty=format:%ct` - ver_date=`perl -MPOSIX -e "print strftime('%Y%m%d', gmtime($ver_posixtime));"` - if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else - changequote([, ])dnl - AC_MSG_ERROR([failed to detect version date: check that git and perl are in your path]) + if test "$RELEASE" = "NO"; then + AC_MSG_CHECKING([for GHC version date]) + if test -f VERSION_DATE; then + PACKAGE_VERSION=${PACKAGE_VERSION}.`cat VERSION_DATE` + AC_MSG_RESULT(given $PACKAGE_VERSION) + elif test -e .git; then + changequote(, )dnl + ver_posixtime=`git log -1 --pretty=format:%ct` + ver_date=`perl -MPOSIX -e "print strftime('%Y%m%d', gmtime($ver_posixtime));"` + if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else + changequote([, ])dnl + AC_MSG_ERROR([failed to detect version date: check that git and perl are in your path]) + fi + PACKAGE_VERSION=${PACKAGE_VERSION}.$ver_date + AC_MSG_RESULT(inferred $PACKAGE_VERSION) + elif test -f VERSION; then + PACKAGE_VERSION=`cat VERSION` + AC_MSG_RESULT(given $PACKAGE_VERSION) + else + AC_MSG_WARN([cannot determine snapshot version: no .git directory and no VERSION file]) + dnl We'd really rather this case didn't happen, but it might + dnl do (in particular, people using lndir trees may find that + dnl the build system can't find any other date). If it does + dnl happen, then we use the current date. + dnl This way we get some idea about how recent a build is. + dnl It also means that packages built for 2 different builds + dnl will probably use different version numbers, so things are + dnl less likely to go wrong. + PACKAGE_VERSION=${PACKAGE_VERSION}.`date +%Y%m%d` fi - PACKAGE_VERSION=${PACKAGE_VERSION}.$ver_date - AC_MSG_RESULT(inferred $PACKAGE_VERSION) - elif test -f VERSION; then - PACKAGE_VERSION=`cat VERSION` - AC_MSG_RESULT(given $PACKAGE_VERSION) - else - AC_MSG_WARN([cannot determine snapshot version: no .git directory and no VERSION file]) - dnl We'd really rather this case didn't happen, but it might - dnl do (in particular, people using lndir trees may find that - dnl the build system can't find any other date). If it does - dnl happen, then we use the current date. - dnl This way we get some idea about how recent a build is. - dnl It also means that packages built for 2 different builds - dnl will probably use different version numbers, so things are - dnl less likely to go wrong. - PACKAGE_VERSION=${PACKAGE_VERSION}.`date +%Y%m%d` fi -fi AC_MSG_CHECKING([for GHC Git commit id]) if test -e .git; then @@ -1676,54 +1676,54 @@ fi fi -# Some renamings -AC_SUBST([ProjectName], [$PACKAGE_NAME]) -AC_SUBST([ProjectVersion], [$PACKAGE_VERSION]) -AC_SUBST([ProjectGitCommitId], [$PACKAGE_GIT_COMMIT_ID]) + # Some renamings + AC_SUBST([ProjectName], [$PACKAGE_NAME]) + AC_SUBST([ProjectVersion], [$PACKAGE_VERSION]) + AC_SUBST([ProjectGitCommitId], [$PACKAGE_GIT_COMMIT_ID]) -# Split PACKAGE_VERSION into (possibly empty) parts -VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` -VERSION_TMP=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` -VERSION_MINOR=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` -ProjectPatchLevel=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` + # Split PACKAGE_VERSION into (possibly empty) parts + VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` + VERSION_TMP=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` + VERSION_MINOR=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` + ProjectPatchLevel=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` -# Calculate project version as an integer, using 2 digits for minor version -case $VERSION_MINOR in - ?) ProjectVersionInt=${VERSION_MAJOR}0${VERSION_MINOR} ;; - ??) ProjectVersionInt=${VERSION_MAJOR}${VERSION_MINOR} ;; - *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;; -esac -AC_SUBST([ProjectVersionInt]) + # Calculate project version as an integer, using 2 digits for minor version + case $VERSION_MINOR in + ?) ProjectVersionInt=${VERSION_MAJOR}0${VERSION_MINOR} ;; + ??) ProjectVersionInt=${VERSION_MAJOR}${VERSION_MINOR} ;; + *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;; + esac + AC_SUBST([ProjectVersionInt]) -# The project patchlevel is zero unless stated otherwise -test -z "$ProjectPatchLevel" && ProjectPatchLevel=0 + # The project patchlevel is zero unless stated otherwise + test -z "$ProjectPatchLevel" && ProjectPatchLevel=0 -# Save split version of ProjectPatchLevel -ProjectPatchLevel1=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1/'` -ProjectPatchLevel2=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3/'` + # Save split version of ProjectPatchLevel + ProjectPatchLevel1=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1/'` + ProjectPatchLevel2=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3/'` -AC_SUBST([ProjectPatchLevel1]) -AC_SUBST([ProjectPatchLevel2]) + AC_SUBST([ProjectPatchLevel1]) + AC_SUBST([ProjectPatchLevel2]) -# Remove dots from the patch level; this allows us to have versions like 6.4.1.20050508 -ProjectPatchLevel=`echo $ProjectPatchLevel | sed 's/\.//'` + # Remove dots from the patch level; this allows us to have versions like 6.4.1.20050508 + ProjectPatchLevel=`echo $ProjectPatchLevel | sed 's/\.//'` -AC_SUBST([ProjectPatchLevel]) + AC_SUBST([ProjectPatchLevel]) -# The version of the GHC package changes every day, since the -# patchlevel is the current date. We don't want to force -# recompilation of the entire compiler when this happens, so for -# GHC HEAD we omit the patchlevel from the package version number. -# -# The ProjectPatchLevel1 > 20000000 iff GHC HEAD. If it's for a stable -# release like 7.10.1 or for a release candidate such as 7.10.1.20141224 -# then we don't omit the patchlevel components. + # The version of the GHC package changes every day, since the + # patchlevel is the current date. We don't want to force + # recompilation of the entire compiler when this happens, so for + # GHC HEAD we omit the patchlevel from the package version number. + # + # The ProjectPatchLevel1 > 20000000 iff GHC HEAD. If it's for a stable + # release like 7.10.1 or for a release candidate such as 7.10.1.20141224 + # then we don't omit the patchlevel components. -ProjectVersionMunged="$ProjectVersion" -if test "$ProjectPatchLevel1" -gt 20000000; then - ProjectVersionMunged="${VERSION_MAJOR}.${VERSION_MINOR}" -fi -AC_SUBST([ProjectVersionMunged]) + ProjectVersionMunged="$ProjectVersion" + if test "$ProjectPatchLevel1" -gt 20000000; then + ProjectVersionMunged="${VERSION_MAJOR}.${VERSION_MINOR}" + fi + AC_SUBST([ProjectVersionMunged]) ])# FP_SETUP_PROJECT_VERSION # Check for a working timer_create(). We need a pretty detailed check ===================================== testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 deleted ===================================== @@ -1,160 +0,0 @@ -[(AnnotationTuple.hs:14:20, [p], Solo 1), - (AnnotationTuple.hs:14:23-29, [p], Solo "hello"), - (AnnotationTuple.hs:14:35-37, [p], Solo 6.5), - (AnnotationTuple.hs:14:39, [m], ()), - (AnnotationTuple.hs:14:41-52, [p], Solo [5, 5, 6, 7]), - (AnnotationTuple.hs:16:8, [p], Solo 1), - (AnnotationTuple.hs:16:11-17, [p], Solo "hello"), - (AnnotationTuple.hs:16:20-22, [p], Solo 6.5), - (AnnotationTuple.hs:16:24, [m], ()), - (AnnotationTuple.hs:16:25, [m], ()), - (AnnotationTuple.hs:16:26, [m], ()), (, [m], ())] -[ -(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1]) - -(AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6]) - -(AK AnnotationTuple.hs:1:1 AnnOpenC = [AnnotationTuple.hs:5:1]) - -(AK AnnotationTuple.hs:1:1 AnnWhere = [AnnotationTuple.hs:3:30-34]) - -(AK AnnotationTuple.hs:3:24-28 AnnCloseP = [AnnotationTuple.hs:3:28]) - -(AK AnnotationTuple.hs:3:24-28 AnnOpenP = [AnnotationTuple.hs:3:24]) - -(AK AnnotationTuple.hs:6:1-32 AnnAs = [AnnotationTuple.hs:6:28-29]) - -(AK AnnotationTuple.hs:6:1-32 AnnImport = [AnnotationTuple.hs:6:1-6]) - -(AK AnnotationTuple.hs:6:1-32 AnnQualified = [AnnotationTuple.hs:6:8-16]) - -(AK AnnotationTuple.hs:6:1-32 AnnSemi = [AnnotationTuple.hs:7:1]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnEqual = [AnnotationTuple.hs:8:5]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnFunId = [AnnotationTuple.hs:8:1-3]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnSemi = [AnnotationTuple.hs:13:1]) - -(AK AnnotationTuple.hs:(8,7)-(11,14) AnnIn = [AnnotationTuple.hs:11:7-8]) - -(AK AnnotationTuple.hs:(8,7)-(11,14) AnnLet = [AnnotationTuple.hs:8:7-9]) - -(AK AnnotationTuple.hs:9:9-13 AnnEqual = [AnnotationTuple.hs:9:11]) - -(AK AnnotationTuple.hs:9:9-13 AnnFunId = [AnnotationTuple.hs:9:9]) - -(AK AnnotationTuple.hs:9:9-13 AnnSemi = [AnnotationTuple.hs:10:9]) - -(AK AnnotationTuple.hs:10:9-13 AnnEqual = [AnnotationTuple.hs:10:11]) - -(AK AnnotationTuple.hs:10:9-13 AnnFunId = [AnnotationTuple.hs:10:9]) - -(AK AnnotationTuple.hs:11:10-14 AnnVal = [AnnotationTuple.hs:11:12]) - -(AK AnnotationTuple.hs:14:1-72 AnnEqual = [AnnotationTuple.hs:14:5]) - -(AK AnnotationTuple.hs:14:1-72 AnnFunId = [AnnotationTuple.hs:14:1-3]) - -(AK AnnotationTuple.hs:14:1-72 AnnSemi = [AnnotationTuple.hs:15:1]) - -(AK AnnotationTuple.hs:14:7-72 AnnVal = [AnnotationTuple.hs:14:13]) - -(AK AnnotationTuple.hs:14:19-53 AnnCloseP = [AnnotationTuple.hs:14:53]) - -(AK AnnotationTuple.hs:14:19-53 AnnOpenP = [AnnotationTuple.hs:14:19]) - -(AK AnnotationTuple.hs:14:20 AnnComma = [AnnotationTuple.hs:14:21]) - -(AK AnnotationTuple.hs:14:23-29 AnnComma = [AnnotationTuple.hs:14:33]) - -(AK AnnotationTuple.hs:14:35-37 AnnComma = [AnnotationTuple.hs:14:38]) - -(AK AnnotationTuple.hs:14:39 AnnComma = [AnnotationTuple.hs:14:39]) - -(AK AnnotationTuple.hs:14:41-52 AnnCloseS = [AnnotationTuple.hs:14:52]) - -(AK AnnotationTuple.hs:14:41-52 AnnOpenS = [AnnotationTuple.hs:14:41]) - -(AK AnnotationTuple.hs:14:42 AnnComma = [AnnotationTuple.hs:14:43]) - -(AK AnnotationTuple.hs:14:45 AnnComma = [AnnotationTuple.hs:14:46]) - -(AK AnnotationTuple.hs:14:48 AnnComma = [AnnotationTuple.hs:14:49]) - -(AK AnnotationTuple.hs:14:55-72 AnnCloseS = [AnnotationTuple.hs:14:72]) - -(AK AnnotationTuple.hs:14:55-72 AnnOpenS = [AnnotationTuple.hs:14:55]) - -(AK AnnotationTuple.hs:14:56-62 AnnComma = [AnnotationTuple.hs:14:63]) - -(AK AnnotationTuple.hs:14:61-62 AnnCloseP = [AnnotationTuple.hs:14:62]) - -(AK AnnotationTuple.hs:14:61-62 AnnOpenP = [AnnotationTuple.hs:14:61]) - -(AK AnnotationTuple.hs:16:1-41 AnnEqual = [AnnotationTuple.hs:16:5]) - -(AK AnnotationTuple.hs:16:1-41 AnnFunId = [AnnotationTuple.hs:16:1-3]) - -(AK AnnotationTuple.hs:16:1-41 AnnSemi = [AnnotationTuple.hs:17:1]) - -(AK AnnotationTuple.hs:16:7-27 AnnCloseP = [AnnotationTuple.hs:16:27]) - -(AK AnnotationTuple.hs:16:7-27 AnnOpenP = [AnnotationTuple.hs:16:7]) - -(AK AnnotationTuple.hs:16:8 AnnComma = [AnnotationTuple.hs:16:9]) - -(AK AnnotationTuple.hs:16:11-17 AnnComma = [AnnotationTuple.hs:16:18]) - -(AK AnnotationTuple.hs:16:20-22 AnnComma = [AnnotationTuple.hs:16:23]) - -(AK AnnotationTuple.hs:16:24 AnnComma = [AnnotationTuple.hs:16:24]) - -(AK AnnotationTuple.hs:16:25 AnnComma = [AnnotationTuple.hs:16:25]) - -(AK AnnotationTuple.hs:16:26 AnnComma = [AnnotationTuple.hs:16:26]) - -(AK AnnotationTuple.hs:16:33-41 AnnCloseP = [AnnotationTuple.hs:16:41]) - -(AK AnnotationTuple.hs:16:33-41 AnnOpenP = [AnnotationTuple.hs:16:33]) - -(AK AnnotationTuple.hs:16:39-40 AnnCloseP = [AnnotationTuple.hs:16:40]) - -(AK AnnotationTuple.hs:16:39-40 AnnOpenP = [AnnotationTuple.hs:16:39]) - -(AK AnnotationTuple.hs:18:1-28 AnnData = [AnnotationTuple.hs:18:1-4]) - -(AK AnnotationTuple.hs:18:1-28 AnnDcolon = [AnnotationTuple.hs:18:20-21]) - -(AK AnnotationTuple.hs:18:1-28 AnnFamily = [AnnotationTuple.hs:18:6-11]) - -(AK AnnotationTuple.hs:18:1-28 AnnSemi = [AnnotationTuple.hs:19:1]) - -(AK AnnotationTuple.hs:18:23 AnnRarrow = [AnnotationTuple.hs:18:25-26]) - -(AK AnnotationTuple.hs:18:23-28 AnnRarrow = [AnnotationTuple.hs:18:25-26]) - -(AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5]) - -(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1]) - -(AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7]) - -(AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7]) - -(AK AnnotationTuple.hs:21:9-24 AnnComma = [AnnotationTuple.hs:22:7]) - -(AK AnnotationTuple.hs:21:9-24 AnnLarrow = [AnnotationTuple.hs:21:16-17]) - -(AK AnnotationTuple.hs:22:9-25 AnnComma = [AnnotationTuple.hs:23:7]) - -(AK AnnotationTuple.hs:22:9-25 AnnLarrow = [AnnotationTuple.hs:22:16-17]) - -(AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) - -(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) - -(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) -] - -EOF: Just SrcSpanPoint ".\\AnnotationTuple.hs" 32 1 ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -141,8 +141,11 @@ test('T5979', normalise_slashes, normalise_version("transformers")], ghci_script, ['T5979.script']) -test('T5975a', [pre_cmd('touch föøbàr1.hs')], ghci_script, ['T5975a.script']) -test('T5975b', [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs')], +test('T5975a', + [pre_cmd('touch föøbàr1.hs'), when(opsys('mingw32'), expect_broken(7305))], + ghci_script, ['T5975a.script']) +test('T5975b', + [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs'), when(opsys('mingw32'), expect_broken(7305))], ghci_script, ['T5975b.script']) test('T6027ghci', normal, ghci_script, ['T6027ghci.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7980ae23696f2406c65ee498155b26c09d3d4394...643785e3835de2de6c575e6418db0d4598b72a7d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7980ae23696f2406c65ee498155b26c09d3d4394...643785e3835de2de6c575e6418db0d4598b72a7d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 15:28:47 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Sun, 06 Sep 2020 11:28:47 -0400 Subject: [Git][ghc/ghc][wip/T16762] 58 commits: Grammar for types and data/newtype constructors Message-ID: <5f55002f73213_80b10251e481079047a@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - d0654f74 by Ryan Scott at 2020-08-22T09:47:06-04:00 WIP: T16762 [ci skip] - - - - - 1b557251 by Ryan Scott at 2020-09-06T11:28:17-04:00 WIP: T16762 (part 2) [ci skip] - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Ppr/Decl.hs - compiler/GHC/Cmm/Ppr/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f4428b42a5d61224aba5b7f74f5ecaf4b717094...1b557251a2f6e4ffcadc5806801792346df5c43e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3f4428b42a5d61224aba5b7f74f5ecaf4b717094...1b557251a2f6e4ffcadc5806801792346df5c43e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 17:29:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Sep 2020 13:29:47 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 3 commits: gitlab-ci: Bump Docker images Message-ID: <5f551c8b2b83e_80b3f848d83e3241079562a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 70cdc763 by Ben Gamari at 2020-09-06T13:29:42-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 66dd727d by Ben Gamari at 2020-09-06T13:29:42-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 6639e385 by Ben Gamari at 2020-09-06T13:29:42-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 7 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: 6f9b0e5780b80d4d50bc7596ac3fa2856c445cdf # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb101010101010101010:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10 + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10 + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +207,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5603e233a26206080f3199e1e074f112a75f59bd...6639e3859b1d122fda2123635fef23913be25c18 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5603e233a26206080f3199e1e074f112a75f59bd...6639e3859b1d122fda2123635fef23913be25c18 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 18:56:22 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Sep 2020 14:56:22 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 3 commits: gitlab-ci: Bump Docker images Message-ID: <5f5530d683963_80b3f83f3151538107994bb@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 16ff1144 by Ben Gamari at 2020-09-06T14:56:18-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 1b2e1876 by Ben Gamari at 2020-09-06T14:56:18-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - af205e5f by Ben Gamari at 2020-09-06T14:56:18-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 7 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: 6f9b0e5780b80d4d50bc7596ac3fa2856c445cdf # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10 + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +207,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6639e3859b1d122fda2123635fef23913be25c18...af205e5f9ed01992540291dac53594ab6fcb4644 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6639e3859b1d122fda2123635fef23913be25c18...af205e5f9ed01992540291dac53594ab6fcb4644 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 18:57:10 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Sep 2020 14:57:10 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 3 commits: gitlab-ci: Bump Docker images Message-ID: <5f553106ee70_80be83a014108000b2@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 1b6ffda8 by Ben Gamari at 2020-09-06T14:57:04-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 44bab09b by Ben Gamari at 2020-09-06T14:57:04-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - a072f5aa by Ben Gamari at 2020-09-06T14:57:04-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 7 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: 6f9b0e5780b80d4d50bc7596ac3fa2856c445cdf # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10: + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: ===================================== .gitlab/ci.sh ===================================== @@ -122,22 +122,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +178,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +207,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +253,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af205e5f9ed01992540291dac53594ab6fcb4644...a072f5aa908c61b0dcdcb79c3ff6d51b021ac04e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/af205e5f9ed01992540291dac53594ab6fcb4644...a072f5aa908c61b0dcdcb79c3ff6d51b021ac04e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 18:59:06 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Sun, 06 Sep 2020 14:59:06 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] 80 commits: typecheck: Drop SPECIALISE pragmas when there is no unfolding Message-ID: <5f55317a86049_80b3f8459445be810800431@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 7a85e394 by Alan Zimmerman at 2020-09-03T19:50:04+01:00 Proof of Concept implementation of in-tree API Annotations This MR introduces a possible machinery to introduce API Annotations into the TTG extension points. It is intended to be a concrete example for discussion. It still needs to process comments. ---- Work in progress, adding more TTG extensions for annotations. And fixing ppr round-trip tests by being able to blank out in-tree annotations, as done with SrcSpans. This is needed for the case of class Foo a where for which current ppr does not print the "where". Rename AA to AddApiAnn and AA to AddAnn Add XConPatIn and XConPatOut Rebase ---- First pass at bringing in LocatedA for API anns in locations Treatment of ECP in parsing is provisional at this stage, leads to some horribly stuff in Parser.y and RdrHsSyn. It is an extensive but not invasive change. I think (AZ). Locally it reports some parsing tests using less memory. Add ApiAnns to the HsExpr data structure. rebase. Change HsMatchContext and HsStmtContext to use an id, not a GhcPass parameter. Add ApiAnns to Hs/Types Rebase Rebased 2020-03-25 WIP on in-tree annotations Includes updating HsModule Imports LocateA ImportDecl so we can hang AnnSemi off it A whole bunch of stuff more InjectivityAnn and FamEqn now have annotations in them Add annotations to context srcspan ---- In-tree annotations: LHsDecl and LHsBind LocatedA ---- WIP on in-tree annotations ---- in-tree annotations: LHsType is now LocatedA ---- FunDeps is now also a HS data type ---- WIP. Added LocatedA to Pat, Expr, Decl And worked some more through Parser.y ---- LStmt now Located ---- Finished working through Parser.y, tests seem ok failures relate to annotations. Adding test infrastructure for check-exact Like check-ppr, but checking for an exact reproduction of the parsed source file. Starting to work on actual exact printer Bring in ApiAnnName As an alternative for LocatedA, to be used for names only. Carrying extra name adornments, such as locations of backticks, parens, etc. Working on changing ApiAnnName to accurately reflect actual usage Get rid of AnnApiName in favour of LocatedN Working on check-exact. Making progress Working on the ghc-exact bit Progress, can reproduce the first Test.hs file. Move API Annotations out of the extensions to annotations - - - - - e2e5dd83 by Alan Zimmerman at 2020-09-03T19:51:17+01:00 Remove LHsLocalBinds - - - - - 4628b5c3 by Alan Zimmerman at 2020-09-06T19:58:16+01:00 Fix up after rebasing to bring in XRec Main thing is to make type instance XRec (GhcPass p) a = GenLocated (Anno a) a type family Anno a = b But this has massive implications. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - .gitmodules - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Names/TH.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Types/Prim.hs - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Builtin/Uniques.hs-boot - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/Cmm.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/CallConv.hs - compiler/GHC/Cmm/CommonBlockElim.hs - compiler/GHC/Cmm/DebugBlock.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/Cmm/Parser.y The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d563bb0248bcbc0056701631f3da22f8a6352c4...4628b5c3f4d8f87d8e13c82ecff1341798342dd7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7d563bb0248bcbc0056701631f3da22f8a6352c4...4628b5c3f4d8f87d8e13c82ecff1341798342dd7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 22:13:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Sep 2020 18:13:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports Message-ID: <5f555f1b83a31_80bf53bc541080909e@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 22:15:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Sep 2020 18:15:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/hadrian-bignum Message-ID: <5f555f93153b0_80b3f8468cb1174108109a1@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/hadrian-bignum at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/hadrian-bignum You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 22:18:28 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Sep 2020 18:18:28 -0400 Subject: [Git][ghc/ghc][wip/hadrian-bignum] gitlab-ci: Use hadrian builds for Windows release artifacts Message-ID: <5f556034c01e8_80b3f849c661470108127f1@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/hadrian-bignum at Glasgow Haskell Compiler / GHC Commits: 27163005 by Ben Gamari at 2020-09-06T18:18:23-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -856,13 +856,16 @@ validate-x86_64-linux-fedora27: - ghc.tar.xz - junit.xml -validate-x86_64-windows-hadrian: +.build-x86_64-windows-hadrian: extends: .build-windows-hadrian variables: MSYSTEM: MINGW64 - TEST_ENV: "x86_64-windows-hadrian" + TEST_ENV: "x86_64-windows" cache: - key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" + key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" + +validate-x86_64-windows-hadrian: + extends: .build-x86_64-windows-hadrian .build-windows-make: extends: .build-windows @@ -906,13 +909,13 @@ nightly-x86_64-windows: # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BUILD_FLAVOUR: "perf" - # + release-x86_64-windows-integer-simple: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/27163005caa0e1fcdf4ee49eb1da8fc8903d194e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/27163005caa0e1fcdf4ee49eb1da8fc8903d194e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 22:19:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Sep 2020 18:19:01 -0400 Subject: [Git][ghc/ghc][wip/hadrian-bignum] gitlab-ci: Use hadrian builds for Windows release artifacts Message-ID: <5f556055624f8_80b3f8468cb117410813144@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/hadrian-bignum at Glasgow Haskell Compiler / GHC Commits: b03c54e8 by Ben Gamari at 2020-09-06T18:18:56-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -856,13 +856,16 @@ validate-x86_64-linux-fedora27: - ghc.tar.xz - junit.xml -validate-x86_64-windows-hadrian: +.build-x86_64-windows-hadrian: extends: .build-windows-hadrian variables: MSYSTEM: MINGW64 - TEST_ENV: "x86_64-windows-hadrian" + TEST_ENV: "x86_64-windows" cache: - key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" + key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" + +validate-x86_64-windows-hadrian: + extends: .build-x86_64-windows-hadrian .build-windows-make: extends: .build-windows @@ -903,16 +906,17 @@ nightly-x86_64-windows: variables: BUILD_FLAVOUR: "validate" -# Normal Windows validate builds are profiled; that won't do for releases. +# Normal Windows validate builds lack profiled libraries; that won't do for +# releases. release-x86_64-windows: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BUILD_FLAVOUR: "perf" - # + release-x86_64-windows-integer-simple: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b03c54e8ffa4396f29512cc45e952b9ebb371e71 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b03c54e8ffa4396f29512cc45e952b9ebb371e71 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Sun Sep 6 22:34:25 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Sun, 06 Sep 2020 18:34:25 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] Fix up after rebasing to bring in XRec Message-ID: <5f5563f1c6f23_80b3f849c0f00681081354e@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: fb5aab01 by Alan Zimmerman at 2020-09-06T23:33:57+01:00 Fix up after rebasing to bring in XRec Main thing is to make type instance XRec (GhcPass p) a = GenLocated (Anno a) a type family Anno a = b But this has massive implications. - - - - - 25 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Pat.hs-boot - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb5aab018d2e01b76009418dc63e905599b2d272 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/fb5aab018d2e01b76009418dc63e905599b2d272 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 02:43:35 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Sun, 06 Sep 2020 22:43:35 -0400 Subject: [Git][ghc/ghc][wip/hadrian-bignum] 2 commits: gitlab-ci: Configure bignum backend in Hadrian builds Message-ID: <5f559e57f1a83_80b3f84869da04010816878@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/hadrian-bignum at Glasgow Haskell Compiler / GHC Commits: 635dc134 by Ben Gamari at 2020-09-06T22:23:06-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - ecf26568 by Ben Gamari at 2020-09-06T22:23:06-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -856,13 +856,16 @@ validate-x86_64-linux-fedora27: - ghc.tar.xz - junit.xml -validate-x86_64-windows-hadrian: +.build-x86_64-windows-hadrian: extends: .build-windows-hadrian variables: MSYSTEM: MINGW64 - TEST_ENV: "x86_64-windows-hadrian" + TEST_ENV: "x86_64-windows" cache: - key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" + key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" + +validate-x86_64-windows-hadrian: + extends: .build-x86_64-windows-hadrian .build-windows-make: extends: .build-windows @@ -903,16 +906,17 @@ nightly-x86_64-windows: variables: BUILD_FLAVOUR: "validate" -# Normal Windows validate builds are profiled; that won't do for releases. +# Normal Windows validate builds lack profiled libraries; that won't do for +# releases. release-x86_64-windows: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BUILD_FLAVOUR: "perf" - # + release-x86_64-windows-integer-simple: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" ===================================== .gitlab/ci.sh ===================================== @@ -427,10 +427,12 @@ function clean() { } function run_hadrian() { + if [ -z "$BIGNUM_BACKEND" ]; then BIGNUM_BACKEND="gmp"; fi run hadrian/build-cabal \ --flavour="$FLAVOUR" \ -j"$cores" \ --broken-test="$BROKEN_TESTS" \ + --bignum=$BIGNUM_BACKEND \ $HADRIAN_ARGS \ $@ } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b03c54e8ffa4396f29512cc45e952b9ebb371e71...ecf26568932299e8229d61e3d7f2104d0377e817 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/b03c54e8ffa4396f29512cc45e952b9ebb371e71...ecf26568932299e8229d61e3d7f2104d0377e817 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 07:18:43 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 03:18:43 -0400 Subject: [Git][ghc/ghc][wip/backports] 2 commits: gitlab-ci: Configure bignum backend in Hadrian builds Message-ID: <5f55ded3b3dfb_80b1167e7cc10822476@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports at Glasgow Haskell Compiler / GHC Commits: 104b0ccd by Ben Gamari at 2020-09-07T03:18:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - cee137dc by Ben Gamari at 2020-09-07T03:18:32-04:00 gitlab-ci: Use hadrian builds for Window release artifacts - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -879,13 +879,13 @@ nightly-x86_64-windows: # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release - extends: validate-x86_64-windows + extends: validate-x86_64-windows-hadrian variables: BUILD_FLAVOUR: "perf" - # + release-x86_64-windows-integer-simple: <<: *release - extends: validate-x86_64-windows + extends: validate-x86_64-windows-hadrian variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" ===================================== .gitlab/ci.sh ===================================== @@ -427,10 +427,12 @@ function clean() { } function run_hadrian() { + if [ -z "$BIGNUM_BACKEND" ]; then BIGNUM_BACKEND="gmp"; fi run hadrian/build-cabal \ --flavour="$FLAVOUR" \ -j"$cores" \ --broken-test="$BROKEN_TESTS" \ + --bignum=$BIGNUM_BACKEND \ $HADRIAN_ARGS \ $@ } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46fa939cf58401d4e933012f705618f888aafb97...cee137dcab0b33915b0add69db9535ef4227f824 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46fa939cf58401d4e933012f705618f888aafb97...cee137dcab0b33915b0add69db9535ef4227f824 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 08:33:57 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 07 Sep 2020 04:33:57 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 12 commits: rts: Consistently use stgMallocBytes instead of malloc Message-ID: <5f55f07574dd9_80b3f843511686010830233@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - 487a8fb6 by Wander Hillen at 2020-09-07T04:33:46-04:00 Add clarification regarding poll/kqueue flags - - - - - f7bc4430 by Ben Gamari at 2020-09-07T04:33:46-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - 43d84527 by Ben Gamari at 2020-09-07T04:33:46-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 11 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - libraries/base/configure.ac - rts/linker/PEi386.c - rts/win32/IOManager.c - rts/win32/OSThreads.c - rts/win32/WorkQueue.c - rts/xxhash.c - − testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 - testsuite/tests/ghci/scripts/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -6,7 +6,7 @@ variables: # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. - WINDOWS_TOOLCHAIN_VERSION: 1 + WINDOWS_TOOLCHAIN_VERSION: 2 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 @@ -49,7 +49,7 @@ workflow: - if: $CI_COMMIT_TAG - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH == "wip/marge_bot_batch_merge_job"' - - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' + - if: '$CI_COMMIT_BRANCH =~ /ghc-[0-9]+\.[0-9]+/' - if: '$CI_PIPELINE_SOURCE == "web"' .nightly: &nightly @@ -67,7 +67,7 @@ workflow: when: always expire_in: 1 year rules: - - if: '$RELEASE == "yes"' + - if: '$RELEASE_JOB == "yes"' ############################################################ # Runner Tags @@ -856,13 +856,16 @@ validate-x86_64-linux-fedora27: - ghc.tar.xz - junit.xml -validate-x86_64-windows-hadrian: +.build-x86_64-windows-hadrian: extends: .build-windows-hadrian variables: MSYSTEM: MINGW64 - TEST_ENV: "x86_64-windows-hadrian" + TEST_ENV: "x86_64-windows" cache: - key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" + key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" + +validate-x86_64-windows-hadrian: + extends: .build-x86_64-windows-hadrian .build-windows-make: extends: .build-windows @@ -896,9 +899,6 @@ validate-x86_64-windows-hadrian: cache: key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" -validate-x86_64-windows: - extends: .build-x86_64-windows-make - nightly-x86_64-windows: <<: *nightly extends: .build-x86_64-windows-make @@ -906,16 +906,17 @@ nightly-x86_64-windows: variables: BUILD_FLAVOUR: "validate" -# Normal Windows validate builds are profiled; that won't do for releases. +# Normal Windows validate builds lack profiled libraries; that won't do for +# releases. release-x86_64-windows: <<: *release - extends: validate-x86_64-windows + extends: .build-x86_64-windows-hadrian variables: BUILD_FLAVOUR: "perf" - # + release-x86_64-windows-integer-simple: <<: *release - extends: validate-x86_64-windows + extends: .build-x86_64-windows-hadrian variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" @@ -970,7 +971,7 @@ doc-tarball: image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" dependencies: - validate-x86_64-linux-deb9-debug - - validate-x86_64-windows + - validate-x86_64-windows-hadrian variables: LINUX_BINDIST: "ghc-x86_64-deb9-linux-debug.tar.xz" WINDOWS_BINDIST: "ghc-x86_64-mingw32.tar.xz" ===================================== .gitlab/ci.sh ===================================== @@ -26,9 +26,6 @@ LT_CYAN="1;36" WHITE="1;37" LT_GRAY="0;37" -export LANG=C.UTF-8 -export LC_ALL=C.UTF-8 - # GitLab Pipelines log section delimiters # https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 start_section() { @@ -60,6 +57,30 @@ function run() { TOP="$(pwd)" +function setup_locale() { + # BSD grep terminates early with -q, consequently locale -a will get a + # SIGPIPE and the pipeline will fail with pipefail. + shopt -o -u pipefail + if locale -a | grep -q C.UTF-8; then + # Debian + export LANG=C.UTF-8 + elif locale -a | grep -q C.utf8; then + # Fedora calls it this + export LANG=C.utf8 + elif locale -a | grep -q en_US.UTF-8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.UTF-8 + else + error "Failed to find usable locale" + info "Available locales:" + locale -a + fail "No usable locale, aborting..." + fi + info "Using locale $LANG..." + export LC_ALL=$LANG + shopt -o -s pipefail +} + function mingw_init() { case "$MSYSTEM" in MINGW32) @@ -406,10 +427,12 @@ function clean() { } function run_hadrian() { + if [ -z "$BIGNUM_BACKEND" ]; then BIGNUM_BACKEND="gmp"; fi run hadrian/build-cabal \ --flavour="$FLAVOUR" \ -j"$cores" \ --broken-test="$BROKEN_TESTS" \ + --bignum=$BIGNUM_BACKEND \ $HADRIAN_ARGS \ $@ } @@ -423,6 +446,8 @@ function shell() { run $cmd } +setup_locale + # Determine Cabal data directory case "$(uname)" in MSYS_*|MINGW*) exe=".exe"; cabal_dir="$APPDATA/cabal" ;; ===================================== aclocal.m4 ===================================== @@ -1627,37 +1627,37 @@ AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) # --------------------- AC_DEFUN([FP_SETUP_PROJECT_VERSION], [ -if test "$RELEASE" = "NO"; then - AC_MSG_CHECKING([for GHC version date]) - if test -f VERSION_DATE; then - PACKAGE_VERSION=${PACKAGE_VERSION}.`cat VERSION_DATE` - AC_MSG_RESULT(given $PACKAGE_VERSION) - elif test -e .git; then - changequote(, )dnl - ver_posixtime=`git log -1 --pretty=format:%ct` - ver_date=`perl -MPOSIX -e "print strftime('%Y%m%d', gmtime($ver_posixtime));"` - if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else - changequote([, ])dnl - AC_MSG_ERROR([failed to detect version date: check that git and perl are in your path]) + if test "$RELEASE" = "NO"; then + AC_MSG_CHECKING([for GHC version date]) + if test -f VERSION_DATE; then + PACKAGE_VERSION=${PACKAGE_VERSION}.`cat VERSION_DATE` + AC_MSG_RESULT(given $PACKAGE_VERSION) + elif test -e .git; then + changequote(, )dnl + ver_posixtime=`git log -1 --pretty=format:%ct` + ver_date=`perl -MPOSIX -e "print strftime('%Y%m%d', gmtime($ver_posixtime));"` + if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else + changequote([, ])dnl + AC_MSG_ERROR([failed to detect version date: check that git and perl are in your path]) + fi + PACKAGE_VERSION=${PACKAGE_VERSION}.$ver_date + AC_MSG_RESULT(inferred $PACKAGE_VERSION) + elif test -f VERSION; then + PACKAGE_VERSION=`cat VERSION` + AC_MSG_RESULT(given $PACKAGE_VERSION) + else + AC_MSG_WARN([cannot determine snapshot version: no .git directory and no VERSION file]) + dnl We'd really rather this case didn't happen, but it might + dnl do (in particular, people using lndir trees may find that + dnl the build system can't find any other date). If it does + dnl happen, then we use the current date. + dnl This way we get some idea about how recent a build is. + dnl It also means that packages built for 2 different builds + dnl will probably use different version numbers, so things are + dnl less likely to go wrong. + PACKAGE_VERSION=${PACKAGE_VERSION}.`date +%Y%m%d` fi - PACKAGE_VERSION=${PACKAGE_VERSION}.$ver_date - AC_MSG_RESULT(inferred $PACKAGE_VERSION) - elif test -f VERSION; then - PACKAGE_VERSION=`cat VERSION` - AC_MSG_RESULT(given $PACKAGE_VERSION) - else - AC_MSG_WARN([cannot determine snapshot version: no .git directory and no VERSION file]) - dnl We'd really rather this case didn't happen, but it might - dnl do (in particular, people using lndir trees may find that - dnl the build system can't find any other date). If it does - dnl happen, then we use the current date. - dnl This way we get some idea about how recent a build is. - dnl It also means that packages built for 2 different builds - dnl will probably use different version numbers, so things are - dnl less likely to go wrong. - PACKAGE_VERSION=${PACKAGE_VERSION}.`date +%Y%m%d` fi -fi AC_MSG_CHECKING([for GHC Git commit id]) if test -e .git; then @@ -1676,54 +1676,54 @@ fi fi -# Some renamings -AC_SUBST([ProjectName], [$PACKAGE_NAME]) -AC_SUBST([ProjectVersion], [$PACKAGE_VERSION]) -AC_SUBST([ProjectGitCommitId], [$PACKAGE_GIT_COMMIT_ID]) + # Some renamings + AC_SUBST([ProjectName], [$PACKAGE_NAME]) + AC_SUBST([ProjectVersion], [$PACKAGE_VERSION]) + AC_SUBST([ProjectGitCommitId], [$PACKAGE_GIT_COMMIT_ID]) -# Split PACKAGE_VERSION into (possibly empty) parts -VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` -VERSION_TMP=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` -VERSION_MINOR=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` -ProjectPatchLevel=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` + # Split PACKAGE_VERSION into (possibly empty) parts + VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` + VERSION_TMP=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` + VERSION_MINOR=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` + ProjectPatchLevel=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` -# Calculate project version as an integer, using 2 digits for minor version -case $VERSION_MINOR in - ?) ProjectVersionInt=${VERSION_MAJOR}0${VERSION_MINOR} ;; - ??) ProjectVersionInt=${VERSION_MAJOR}${VERSION_MINOR} ;; - *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;; -esac -AC_SUBST([ProjectVersionInt]) + # Calculate project version as an integer, using 2 digits for minor version + case $VERSION_MINOR in + ?) ProjectVersionInt=${VERSION_MAJOR}0${VERSION_MINOR} ;; + ??) ProjectVersionInt=${VERSION_MAJOR}${VERSION_MINOR} ;; + *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;; + esac + AC_SUBST([ProjectVersionInt]) -# The project patchlevel is zero unless stated otherwise -test -z "$ProjectPatchLevel" && ProjectPatchLevel=0 + # The project patchlevel is zero unless stated otherwise + test -z "$ProjectPatchLevel" && ProjectPatchLevel=0 -# Save split version of ProjectPatchLevel -ProjectPatchLevel1=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1/'` -ProjectPatchLevel2=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3/'` + # Save split version of ProjectPatchLevel + ProjectPatchLevel1=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1/'` + ProjectPatchLevel2=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3/'` -AC_SUBST([ProjectPatchLevel1]) -AC_SUBST([ProjectPatchLevel2]) + AC_SUBST([ProjectPatchLevel1]) + AC_SUBST([ProjectPatchLevel2]) -# Remove dots from the patch level; this allows us to have versions like 6.4.1.20050508 -ProjectPatchLevel=`echo $ProjectPatchLevel | sed 's/\.//'` + # Remove dots from the patch level; this allows us to have versions like 6.4.1.20050508 + ProjectPatchLevel=`echo $ProjectPatchLevel | sed 's/\.//'` -AC_SUBST([ProjectPatchLevel]) + AC_SUBST([ProjectPatchLevel]) -# The version of the GHC package changes every day, since the -# patchlevel is the current date. We don't want to force -# recompilation of the entire compiler when this happens, so for -# GHC HEAD we omit the patchlevel from the package version number. -# -# The ProjectPatchLevel1 > 20000000 iff GHC HEAD. If it's for a stable -# release like 7.10.1 or for a release candidate such as 7.10.1.20141224 -# then we don't omit the patchlevel components. + # The version of the GHC package changes every day, since the + # patchlevel is the current date. We don't want to force + # recompilation of the entire compiler when this happens, so for + # GHC HEAD we omit the patchlevel from the package version number. + # + # The ProjectPatchLevel1 > 20000000 iff GHC HEAD. If it's for a stable + # release like 7.10.1 or for a release candidate such as 7.10.1.20141224 + # then we don't omit the patchlevel components. -ProjectVersionMunged="$ProjectVersion" -if test "$ProjectPatchLevel1" -gt 20000000; then - ProjectVersionMunged="${VERSION_MAJOR}.${VERSION_MINOR}" -fi -AC_SUBST([ProjectVersionMunged]) + ProjectVersionMunged="$ProjectVersion" + if test "$ProjectPatchLevel1" -gt 20000000; then + ProjectVersionMunged="${VERSION_MAJOR}.${VERSION_MINOR}" + fi + AC_SUBST([ProjectVersionMunged]) ])# FP_SETUP_PROJECT_VERSION # Check for a working timer_create(). We need a pretty detailed check ===================================== libraries/base/configure.ac ===================================== @@ -47,9 +47,13 @@ AC_CHECK_FUNCS([clock_gettime]) AC_CHECK_FUNCS([getclock getrusage times]) AC_CHECK_FUNCS([_chsize ftruncate]) -AC_CHECK_FUNCS([epoll_ctl eventfd kevent kevent64 kqueue poll]) - # event-related fun +# The line below already defines HAVE_KQUEUE and HAVE_POLL, so technically some of the +# subsequent portions that redefine them could be skipped. However, we keep those portions +# to keep kqueue/poll in line with HAVE_EPOLL and possible other additions in the future. You +# should be aware of this peculiarity if you try to simulate not having kqueue or poll by +# moving away header files (see also https://gitlab.haskell.org/ghc/ghc/-/issues/9283) +AC_CHECK_FUNCS([epoll_ctl eventfd kevent kevent64 kqueue poll]) if test "$ac_cv_header_sys_epoll_h" = yes && test "$ac_cv_func_epoll_ctl" = yes; then AC_DEFINE([HAVE_EPOLL], [1], [Define if you have epoll support.]) ===================================== rts/linker/PEi386.c ===================================== @@ -735,7 +735,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) error: stgFree(buf); - char* errormsg = malloc(sizeof(char) * 80); + char* errormsg = stgMallocBytes(sizeof(char) * 80, "addDLL_PEi386"); snprintf(errormsg, 80, "addDLL: %" PATH_FMT " or dependencies not loaded. (Win32 error %lu)", dll_name, GetLastError()); /* LoadLibrary failed; return a ptr to the error msg. */ return errormsg; @@ -745,7 +745,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) { const unsigned int init_buf_size = 1024; unsigned int bufsize = init_buf_size; - wchar_t* result = malloc(sizeof(wchar_t) * bufsize); + wchar_t* result = stgMallocBytes(sizeof(wchar_t) * bufsize, "findSystemLibrary_PEi386"); DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL); if (wResult > bufsize) { @@ -755,7 +755,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) if (!wResult) { - free(result); + stgFree(result); return NULL; } @@ -773,7 +773,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) int bufsize = init_buf_size; // Make sure the path is an absolute path - WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* abs_path = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(1)"); DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL); if (!wResult){ IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError())); @@ -791,7 +791,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) else { warnMissingKBLibraryPaths(); - WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* str = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(2)"); wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); if (wResult > init_buf_size) { @@ -804,7 +804,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) } bufsize = wResult + 2 + pathlen(abs_path); - wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize); + wchar_t* newPath = stgMallocBytes(sizeof(wchar_t) * bufsize, "addLibrarySearchPath_PEi386(3)"); wcscpy(newPath, abs_path); wcscat(newPath, L";"); @@ -813,19 +813,19 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); } - free(newPath); - free(abs_path); + stgFree(newPath); + stgFree(abs_path); return str; } if (!result) { sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); - free(abs_path); + stgFree(abs_path); return NULL; } - free(abs_path); + stgFree(abs_path); return result; } ===================================== rts/win32/IOManager.c ===================================== @@ -265,7 +265,7 @@ IOWorkerProc(PVOID param) } // Free the WorkItem DeregisterWorkItem(iom,work); - free(work); + stgFree(work); } else { fprintf(stderr, "unable to fetch work; fatal.\n"); fflush(stderr); @@ -321,7 +321,7 @@ StartIOManager(void) wq = NewWorkQueue(); if ( !wq ) return false; - ioMan = (IOManagerState*)malloc(sizeof(IOManagerState)); + ioMan = (IOManagerState*)stgMallocBytes(sizeof(IOManagerState), "StartIOManager"); if (!ioMan) { FreeWorkQueue(wq); @@ -332,7 +332,7 @@ StartIOManager(void) hExit = CreateEvent ( NULL, true, false, NULL ); if ( !hExit ) { FreeWorkQueue(wq); - free(ioMan); + stgFree(ioMan); return false; } @@ -440,8 +440,7 @@ AddIORequest ( int fd, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return 0; + WorkItem* wItem = (WorkItem*)stgMallocBytse(sizeof(WorkItem), "AddIORequest"); unsigned int reqID = ioMan->requestID++; @@ -471,8 +470,7 @@ AddDelayRequest ( HsInt usecs, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return false; + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddDelayRequest"); unsigned int reqID = ioMan->requestID++; @@ -498,7 +496,7 @@ AddProcRequest ( void* proc, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddProcRequest"); if (!wItem) return false; unsigned int reqID = ioMan->requestID++; @@ -542,7 +540,7 @@ void ShutdownIOManager ( bool wait_threads ) barf("timeEndPeriod failed"); } - free(ioMan); + stgFree(ioMan); ioMan = NULL; } } ===================================== rts/win32/OSThreads.c ===================================== @@ -171,19 +171,19 @@ void freeThreadingResources (void) { if (cpuGroupCache) { - free(cpuGroupCache); + stgFree(cpuGroupCache); cpuGroupCache = NULL; } if (cpuGroupCumulativeCache) { - free(cpuGroupCumulativeCache); + stgFree(cpuGroupCumulativeCache); cpuGroupCumulativeCache = NULL; } if (cpuGroupDistCache) { - free(cpuGroupDistCache); + stgFree(cpuGroupDistCache); cpuGroupDistCache = NULL; } } @@ -240,7 +240,7 @@ getProcessorsDistribution (void) if (!cpuGroupDistCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupDistCache = malloc(n_groups * sizeof(uint8_t)); + cpuGroupDistCache = stgMallocBytes(n_groups * sizeof(uint8_t), "getProcessorsDistribution"); memset(cpuGroupDistCache, MAXIMUM_PROCESSORS, n_groups * sizeof(uint8_t)); for (int i = 0; i < n_groups; i++) @@ -265,7 +265,7 @@ getProcessorsCumulativeSum(void) if (!cpuGroupCumulativeCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupCumulativeCache = malloc(n_groups * sizeof(uint32_t)); + cpuGroupCumulativeCache = stgMallocBytes(n_groups * sizeof(uint32_t), "getProcessorsCumulativeSum"); memset(cpuGroupCumulativeCache, 0, n_groups * sizeof(uint32_t)); #if defined(x86_64_HOST_ARCH) @@ -306,7 +306,7 @@ createProcessorGroupMap (void) uint32_t numProcs = getNumberOfProcessors(); - cpuGroupCache = malloc(numProcs * sizeof(uint8_t)); + cpuGroupCache = stgMallocBytes(numProcs * sizeof(uint8_t), "createProcessorGroupMap"); /* For 32bit Windows and 64bit older than Windows 7, create a default mapping. */ memset(cpuGroupCache, 0, numProcs * sizeof(uint8_t)); @@ -386,7 +386,7 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M ASSERT(n_groups > 0); ASSERT(n_proc > 0); - mask = malloc(n_groups * sizeof(DWORD_PTR)); + mask = stgMallocBytes(n_groups * sizeof(DWORD_PTR), "setThreadAffinity"); memset(mask, 0, n_groups * sizeof(DWORD_PTR)); /* The mask for the individual groups are all 0 based @@ -422,14 +422,14 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M { r = SetThreadAffinityMask(hThread, mask[i]); if (r == 0) { - free(mask); + stgFree(mask); sysErrorBelch("SetThreadAffinity"); stg_exit(EXIT_FAILURE); } } } - free(mask); + stgFree(mask); } void ===================================== rts/win32/WorkQueue.c ===================================== @@ -41,12 +41,7 @@ newSemaphore(int initCount, int max) WorkQueue* NewWorkQueue() { - WorkQueue* wq = (WorkQueue*)malloc(sizeof(WorkQueue)); - - if (!wq) { - queue_error("NewWorkQueue", "malloc() failed"); - return wq; - } + WorkQueue* wq = (WorkQueue*)stgMallocBytes(sizeof(WorkQueue), "NewWorkQueue"); memset(wq, 0, sizeof *wq); ===================================== rts/xxhash.c ===================================== @@ -98,9 +98,11 @@ ***************************************/ /*! Modify the local functions below should you wish to use some other memory routines * for malloc(), free() */ -#include -static void* XXH_malloc(size_t s) { return malloc(s); } -static void XXH_free (void* p) { free(p); } +#include "Rts.h" +#include "RtsUtils.h" + +static void* XXH_malloc(size_t s) { return stgMallocBytes(s, "XXH_malloc"); } +static void XXH_free (void* p) { stgFree(p); } /*! and for memcpy() */ #include static void* XXH_memcpy(void* dest, const void* src, size_t size) { return memcpy(dest,src,size); } ===================================== testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 deleted ===================================== @@ -1,160 +0,0 @@ -[(AnnotationTuple.hs:14:20, [p], Solo 1), - (AnnotationTuple.hs:14:23-29, [p], Solo "hello"), - (AnnotationTuple.hs:14:35-37, [p], Solo 6.5), - (AnnotationTuple.hs:14:39, [m], ()), - (AnnotationTuple.hs:14:41-52, [p], Solo [5, 5, 6, 7]), - (AnnotationTuple.hs:16:8, [p], Solo 1), - (AnnotationTuple.hs:16:11-17, [p], Solo "hello"), - (AnnotationTuple.hs:16:20-22, [p], Solo 6.5), - (AnnotationTuple.hs:16:24, [m], ()), - (AnnotationTuple.hs:16:25, [m], ()), - (AnnotationTuple.hs:16:26, [m], ()), (, [m], ())] -[ -(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1]) - -(AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6]) - -(AK AnnotationTuple.hs:1:1 AnnOpenC = [AnnotationTuple.hs:5:1]) - -(AK AnnotationTuple.hs:1:1 AnnWhere = [AnnotationTuple.hs:3:30-34]) - -(AK AnnotationTuple.hs:3:24-28 AnnCloseP = [AnnotationTuple.hs:3:28]) - -(AK AnnotationTuple.hs:3:24-28 AnnOpenP = [AnnotationTuple.hs:3:24]) - -(AK AnnotationTuple.hs:6:1-32 AnnAs = [AnnotationTuple.hs:6:28-29]) - -(AK AnnotationTuple.hs:6:1-32 AnnImport = [AnnotationTuple.hs:6:1-6]) - -(AK AnnotationTuple.hs:6:1-32 AnnQualified = [AnnotationTuple.hs:6:8-16]) - -(AK AnnotationTuple.hs:6:1-32 AnnSemi = [AnnotationTuple.hs:7:1]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnEqual = [AnnotationTuple.hs:8:5]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnFunId = [AnnotationTuple.hs:8:1-3]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnSemi = [AnnotationTuple.hs:13:1]) - -(AK AnnotationTuple.hs:(8,7)-(11,14) AnnIn = [AnnotationTuple.hs:11:7-8]) - -(AK AnnotationTuple.hs:(8,7)-(11,14) AnnLet = [AnnotationTuple.hs:8:7-9]) - -(AK AnnotationTuple.hs:9:9-13 AnnEqual = [AnnotationTuple.hs:9:11]) - -(AK AnnotationTuple.hs:9:9-13 AnnFunId = [AnnotationTuple.hs:9:9]) - -(AK AnnotationTuple.hs:9:9-13 AnnSemi = [AnnotationTuple.hs:10:9]) - -(AK AnnotationTuple.hs:10:9-13 AnnEqual = [AnnotationTuple.hs:10:11]) - -(AK AnnotationTuple.hs:10:9-13 AnnFunId = [AnnotationTuple.hs:10:9]) - -(AK AnnotationTuple.hs:11:10-14 AnnVal = [AnnotationTuple.hs:11:12]) - -(AK AnnotationTuple.hs:14:1-72 AnnEqual = [AnnotationTuple.hs:14:5]) - -(AK AnnotationTuple.hs:14:1-72 AnnFunId = [AnnotationTuple.hs:14:1-3]) - -(AK AnnotationTuple.hs:14:1-72 AnnSemi = [AnnotationTuple.hs:15:1]) - -(AK AnnotationTuple.hs:14:7-72 AnnVal = [AnnotationTuple.hs:14:13]) - -(AK AnnotationTuple.hs:14:19-53 AnnCloseP = [AnnotationTuple.hs:14:53]) - -(AK AnnotationTuple.hs:14:19-53 AnnOpenP = [AnnotationTuple.hs:14:19]) - -(AK AnnotationTuple.hs:14:20 AnnComma = [AnnotationTuple.hs:14:21]) - -(AK AnnotationTuple.hs:14:23-29 AnnComma = [AnnotationTuple.hs:14:33]) - -(AK AnnotationTuple.hs:14:35-37 AnnComma = [AnnotationTuple.hs:14:38]) - -(AK AnnotationTuple.hs:14:39 AnnComma = [AnnotationTuple.hs:14:39]) - -(AK AnnotationTuple.hs:14:41-52 AnnCloseS = [AnnotationTuple.hs:14:52]) - -(AK AnnotationTuple.hs:14:41-52 AnnOpenS = [AnnotationTuple.hs:14:41]) - -(AK AnnotationTuple.hs:14:42 AnnComma = [AnnotationTuple.hs:14:43]) - -(AK AnnotationTuple.hs:14:45 AnnComma = [AnnotationTuple.hs:14:46]) - -(AK AnnotationTuple.hs:14:48 AnnComma = [AnnotationTuple.hs:14:49]) - -(AK AnnotationTuple.hs:14:55-72 AnnCloseS = [AnnotationTuple.hs:14:72]) - -(AK AnnotationTuple.hs:14:55-72 AnnOpenS = [AnnotationTuple.hs:14:55]) - -(AK AnnotationTuple.hs:14:56-62 AnnComma = [AnnotationTuple.hs:14:63]) - -(AK AnnotationTuple.hs:14:61-62 AnnCloseP = [AnnotationTuple.hs:14:62]) - -(AK AnnotationTuple.hs:14:61-62 AnnOpenP = [AnnotationTuple.hs:14:61]) - -(AK AnnotationTuple.hs:16:1-41 AnnEqual = [AnnotationTuple.hs:16:5]) - -(AK AnnotationTuple.hs:16:1-41 AnnFunId = [AnnotationTuple.hs:16:1-3]) - -(AK AnnotationTuple.hs:16:1-41 AnnSemi = [AnnotationTuple.hs:17:1]) - -(AK AnnotationTuple.hs:16:7-27 AnnCloseP = [AnnotationTuple.hs:16:27]) - -(AK AnnotationTuple.hs:16:7-27 AnnOpenP = [AnnotationTuple.hs:16:7]) - -(AK AnnotationTuple.hs:16:8 AnnComma = [AnnotationTuple.hs:16:9]) - -(AK AnnotationTuple.hs:16:11-17 AnnComma = [AnnotationTuple.hs:16:18]) - -(AK AnnotationTuple.hs:16:20-22 AnnComma = [AnnotationTuple.hs:16:23]) - -(AK AnnotationTuple.hs:16:24 AnnComma = [AnnotationTuple.hs:16:24]) - -(AK AnnotationTuple.hs:16:25 AnnComma = [AnnotationTuple.hs:16:25]) - -(AK AnnotationTuple.hs:16:26 AnnComma = [AnnotationTuple.hs:16:26]) - -(AK AnnotationTuple.hs:16:33-41 AnnCloseP = [AnnotationTuple.hs:16:41]) - -(AK AnnotationTuple.hs:16:33-41 AnnOpenP = [AnnotationTuple.hs:16:33]) - -(AK AnnotationTuple.hs:16:39-40 AnnCloseP = [AnnotationTuple.hs:16:40]) - -(AK AnnotationTuple.hs:16:39-40 AnnOpenP = [AnnotationTuple.hs:16:39]) - -(AK AnnotationTuple.hs:18:1-28 AnnData = [AnnotationTuple.hs:18:1-4]) - -(AK AnnotationTuple.hs:18:1-28 AnnDcolon = [AnnotationTuple.hs:18:20-21]) - -(AK AnnotationTuple.hs:18:1-28 AnnFamily = [AnnotationTuple.hs:18:6-11]) - -(AK AnnotationTuple.hs:18:1-28 AnnSemi = [AnnotationTuple.hs:19:1]) - -(AK AnnotationTuple.hs:18:23 AnnRarrow = [AnnotationTuple.hs:18:25-26]) - -(AK AnnotationTuple.hs:18:23-28 AnnRarrow = [AnnotationTuple.hs:18:25-26]) - -(AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5]) - -(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1]) - -(AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7]) - -(AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7]) - -(AK AnnotationTuple.hs:21:9-24 AnnComma = [AnnotationTuple.hs:22:7]) - -(AK AnnotationTuple.hs:21:9-24 AnnLarrow = [AnnotationTuple.hs:21:16-17]) - -(AK AnnotationTuple.hs:22:9-25 AnnComma = [AnnotationTuple.hs:23:7]) - -(AK AnnotationTuple.hs:22:9-25 AnnLarrow = [AnnotationTuple.hs:22:16-17]) - -(AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) - -(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) - -(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) -] - -EOF: Just SrcSpanPoint ".\\AnnotationTuple.hs" 32 1 ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -141,8 +141,11 @@ test('T5979', normalise_slashes, normalise_version("transformers")], ghci_script, ['T5979.script']) -test('T5975a', [pre_cmd('touch föøbàr1.hs')], ghci_script, ['T5975a.script']) -test('T5975b', [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs')], +test('T5975a', + [pre_cmd('touch föøbàr1.hs'), when(opsys('mingw32'), expect_broken(7305))], + ghci_script, ['T5975a.script']) +test('T5975b', + [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs'), when(opsys('mingw32'), expect_broken(7305))], ghci_script, ['T5975b.script']) test('T6027ghci', normal, ghci_script, ['T6027ghci.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c5f7a35103533495d26d80df30f91f62d6e2650...43d845277424642c447a2e4a13e7e1e1903c16a9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c5f7a35103533495d26d80df30f91f62d6e2650...43d845277424642c447a2e4a13e7e1e1903c16a9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 09:54:19 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 05:54:19 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 12 commits: rts: Consistently use stgMallocBytes instead of malloc Message-ID: <5f56034b584fc_80b3f84540a2c20108344a0@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - deec8bcb by Ben Gamari at 2020-09-07T05:54:08-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 70af694e by Ben Gamari at 2020-09-07T05:54:09-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - b32c4a0f by Ben Gamari at 2020-09-07T05:54:09-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 16 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - rts/linker/PEi386.c - rts/win32/IOManager.c - rts/win32/OSThreads.c - rts/win32/WorkQueue.c - rts/xxhash.c - − testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 - testsuite/tests/ghci/scripts/all.T - testsuite/tests/module/mod184.stderr - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,11 +2,11 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: e1cdfaea745989faa266f09c1d6c4c981aa34dc6 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. - WINDOWS_TOOLCHAIN_VERSION: 1 + WINDOWS_TOOLCHAIN_VERSION: 2 # Disable shallow clones; they break our linting rules GIT_DEPTH: 0 @@ -49,7 +49,7 @@ workflow: - if: $CI_COMMIT_TAG - if: '$CI_COMMIT_BRANCH == "master"' - if: '$CI_COMMIT_BRANCH == "wip/marge_bot_batch_merge_job"' - - if: '$CI_COMMIT_BRANCH =~ /ghc-[0.9]+\.[0-9]+/' + - if: '$CI_COMMIT_BRANCH =~ /ghc-[0-9]+\.[0-9]+/' - if: '$CI_PIPELINE_SOURCE == "web"' .nightly: &nightly @@ -67,7 +67,7 @@ workflow: when: always expire_in: 1 year rules: - - if: '$RELEASE == "yes"' + - if: '$RELEASE_JOB == "yes"' ############################################################ # Runner Tags @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10: + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: @@ -896,9 +896,6 @@ validate-x86_64-windows-hadrian: cache: key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" -validate-x86_64-windows: - extends: .build-x86_64-windows-make - nightly-x86_64-windows: <<: *nightly extends: .build-x86_64-windows-make @@ -909,13 +906,13 @@ nightly-x86_64-windows: # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release - extends: validate-x86_64-windows + extends: .build-x86_64-windows-make variables: BUILD_FLAVOUR: "perf" # release-x86_64-windows-integer-simple: <<: *release - extends: validate-x86_64-windows + extends: .build-x86_64-windows-make variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" @@ -970,7 +967,7 @@ doc-tarball: image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" dependencies: - validate-x86_64-linux-deb9-debug - - validate-x86_64-windows + - validate-x86_64-windows-hadrian variables: LINUX_BINDIST: "ghc-x86_64-deb9-linux-debug.tar.xz" WINDOWS_BINDIST: "ghc-x86_64-mingw32.tar.xz" ===================================== .gitlab/ci.sh ===================================== @@ -26,9 +26,6 @@ LT_CYAN="1;36" WHITE="1;37" LT_GRAY="0;37" -export LANG=C.UTF-8 -export LC_ALL=C.UTF-8 - # GitLab Pipelines log section delimiters # https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 start_section() { @@ -60,6 +57,30 @@ function run() { TOP="$(pwd)" +function setup_locale() { + # BSD grep terminates early with -q, consequently locale -a will get a + # SIGPIPE and the pipeline will fail with pipefail. + shopt -o -u pipefail + if locale -a | grep -q C.UTF-8; then + # Debian + export LANG=C.UTF-8 + elif locale -a | grep -q C.utf8; then + # Fedora calls it this + export LANG=C.utf8 + elif locale -a | grep -q en_US.UTF-8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.UTF-8 + else + error "Failed to find usable locale" + info "Available locales:" + locale -a + fail "No usable locale, aborting..." + fi + info "Using locale $LANG..." + export LC_ALL=$LANG + shopt -o -s pipefail +} + function mingw_init() { case "$MSYSTEM" in MINGW32) @@ -122,22 +143,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -174,12 +199,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -203,12 +228,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -249,7 +274,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; @@ -423,6 +452,8 @@ function shell() { run $cmd } +setup_locale + # Determine Cabal data directory case "$(uname)" in MSYS_*|MINGW*) exe=".exe"; cabal_dir="$APPDATA/cabal" ;; ===================================== aclocal.m4 ===================================== @@ -1627,37 +1627,37 @@ AC_SUBST([GccExtraViaCOpts],$fp_cv_gcc_extra_opts) # --------------------- AC_DEFUN([FP_SETUP_PROJECT_VERSION], [ -if test "$RELEASE" = "NO"; then - AC_MSG_CHECKING([for GHC version date]) - if test -f VERSION_DATE; then - PACKAGE_VERSION=${PACKAGE_VERSION}.`cat VERSION_DATE` - AC_MSG_RESULT(given $PACKAGE_VERSION) - elif test -e .git; then - changequote(, )dnl - ver_posixtime=`git log -1 --pretty=format:%ct` - ver_date=`perl -MPOSIX -e "print strftime('%Y%m%d', gmtime($ver_posixtime));"` - if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else - changequote([, ])dnl - AC_MSG_ERROR([failed to detect version date: check that git and perl are in your path]) + if test "$RELEASE" = "NO"; then + AC_MSG_CHECKING([for GHC version date]) + if test -f VERSION_DATE; then + PACKAGE_VERSION=${PACKAGE_VERSION}.`cat VERSION_DATE` + AC_MSG_RESULT(given $PACKAGE_VERSION) + elif test -e .git; then + changequote(, )dnl + ver_posixtime=`git log -1 --pretty=format:%ct` + ver_date=`perl -MPOSIX -e "print strftime('%Y%m%d', gmtime($ver_posixtime));"` + if echo $ver_date | grep '^[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]$' 2>&1 >/dev/null; then true; else + changequote([, ])dnl + AC_MSG_ERROR([failed to detect version date: check that git and perl are in your path]) + fi + PACKAGE_VERSION=${PACKAGE_VERSION}.$ver_date + AC_MSG_RESULT(inferred $PACKAGE_VERSION) + elif test -f VERSION; then + PACKAGE_VERSION=`cat VERSION` + AC_MSG_RESULT(given $PACKAGE_VERSION) + else + AC_MSG_WARN([cannot determine snapshot version: no .git directory and no VERSION file]) + dnl We'd really rather this case didn't happen, but it might + dnl do (in particular, people using lndir trees may find that + dnl the build system can't find any other date). If it does + dnl happen, then we use the current date. + dnl This way we get some idea about how recent a build is. + dnl It also means that packages built for 2 different builds + dnl will probably use different version numbers, so things are + dnl less likely to go wrong. + PACKAGE_VERSION=${PACKAGE_VERSION}.`date +%Y%m%d` fi - PACKAGE_VERSION=${PACKAGE_VERSION}.$ver_date - AC_MSG_RESULT(inferred $PACKAGE_VERSION) - elif test -f VERSION; then - PACKAGE_VERSION=`cat VERSION` - AC_MSG_RESULT(given $PACKAGE_VERSION) - else - AC_MSG_WARN([cannot determine snapshot version: no .git directory and no VERSION file]) - dnl We'd really rather this case didn't happen, but it might - dnl do (in particular, people using lndir trees may find that - dnl the build system can't find any other date). If it does - dnl happen, then we use the current date. - dnl This way we get some idea about how recent a build is. - dnl It also means that packages built for 2 different builds - dnl will probably use different version numbers, so things are - dnl less likely to go wrong. - PACKAGE_VERSION=${PACKAGE_VERSION}.`date +%Y%m%d` fi -fi AC_MSG_CHECKING([for GHC Git commit id]) if test -e .git; then @@ -1676,54 +1676,54 @@ fi fi -# Some renamings -AC_SUBST([ProjectName], [$PACKAGE_NAME]) -AC_SUBST([ProjectVersion], [$PACKAGE_VERSION]) -AC_SUBST([ProjectGitCommitId], [$PACKAGE_GIT_COMMIT_ID]) + # Some renamings + AC_SUBST([ProjectName], [$PACKAGE_NAME]) + AC_SUBST([ProjectVersion], [$PACKAGE_VERSION]) + AC_SUBST([ProjectGitCommitId], [$PACKAGE_GIT_COMMIT_ID]) -# Split PACKAGE_VERSION into (possibly empty) parts -VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` -VERSION_TMP=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` -VERSION_MINOR=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` -ProjectPatchLevel=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` + # Split PACKAGE_VERSION into (possibly empty) parts + VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` + VERSION_TMP=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` + VERSION_MINOR=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/` + ProjectPatchLevel=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/` -# Calculate project version as an integer, using 2 digits for minor version -case $VERSION_MINOR in - ?) ProjectVersionInt=${VERSION_MAJOR}0${VERSION_MINOR} ;; - ??) ProjectVersionInt=${VERSION_MAJOR}${VERSION_MINOR} ;; - *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;; -esac -AC_SUBST([ProjectVersionInt]) + # Calculate project version as an integer, using 2 digits for minor version + case $VERSION_MINOR in + ?) ProjectVersionInt=${VERSION_MAJOR}0${VERSION_MINOR} ;; + ??) ProjectVersionInt=${VERSION_MAJOR}${VERSION_MINOR} ;; + *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;; + esac + AC_SUBST([ProjectVersionInt]) -# The project patchlevel is zero unless stated otherwise -test -z "$ProjectPatchLevel" && ProjectPatchLevel=0 + # The project patchlevel is zero unless stated otherwise + test -z "$ProjectPatchLevel" && ProjectPatchLevel=0 -# Save split version of ProjectPatchLevel -ProjectPatchLevel1=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1/'` -ProjectPatchLevel2=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3/'` + # Save split version of ProjectPatchLevel + ProjectPatchLevel1=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1/'` + ProjectPatchLevel2=`echo $ProjectPatchLevel | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3/'` -AC_SUBST([ProjectPatchLevel1]) -AC_SUBST([ProjectPatchLevel2]) + AC_SUBST([ProjectPatchLevel1]) + AC_SUBST([ProjectPatchLevel2]) -# Remove dots from the patch level; this allows us to have versions like 6.4.1.20050508 -ProjectPatchLevel=`echo $ProjectPatchLevel | sed 's/\.//'` + # Remove dots from the patch level; this allows us to have versions like 6.4.1.20050508 + ProjectPatchLevel=`echo $ProjectPatchLevel | sed 's/\.//'` -AC_SUBST([ProjectPatchLevel]) + AC_SUBST([ProjectPatchLevel]) -# The version of the GHC package changes every day, since the -# patchlevel is the current date. We don't want to force -# recompilation of the entire compiler when this happens, so for -# GHC HEAD we omit the patchlevel from the package version number. -# -# The ProjectPatchLevel1 > 20000000 iff GHC HEAD. If it's for a stable -# release like 7.10.1 or for a release candidate such as 7.10.1.20141224 -# then we don't omit the patchlevel components. + # The version of the GHC package changes every day, since the + # patchlevel is the current date. We don't want to force + # recompilation of the entire compiler when this happens, so for + # GHC HEAD we omit the patchlevel from the package version number. + # + # The ProjectPatchLevel1 > 20000000 iff GHC HEAD. If it's for a stable + # release like 7.10.1 or for a release candidate such as 7.10.1.20141224 + # then we don't omit the patchlevel components. -ProjectVersionMunged="$ProjectVersion" -if test "$ProjectPatchLevel1" -gt 20000000; then - ProjectVersionMunged="${VERSION_MAJOR}.${VERSION_MINOR}" -fi -AC_SUBST([ProjectVersionMunged]) + ProjectVersionMunged="$ProjectVersion" + if test "$ProjectPatchLevel1" -gt 20000000; then + ProjectVersionMunged="${VERSION_MAJOR}.${VERSION_MINOR}" + fi + AC_SUBST([ProjectVersionMunged]) ])# FP_SETUP_PROJECT_VERSION # Check for a working timer_create(). We need a pretty detailed check ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== rts/linker/PEi386.c ===================================== @@ -735,7 +735,7 @@ addDLL_PEi386( pathchar *dll_name, HINSTANCE *loaded ) error: stgFree(buf); - char* errormsg = malloc(sizeof(char) * 80); + char* errormsg = stgMallocBytes(sizeof(char) * 80, "addDLL_PEi386"); snprintf(errormsg, 80, "addDLL: %" PATH_FMT " or dependencies not loaded. (Win32 error %lu)", dll_name, GetLastError()); /* LoadLibrary failed; return a ptr to the error msg. */ return errormsg; @@ -745,7 +745,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) { const unsigned int init_buf_size = 1024; unsigned int bufsize = init_buf_size; - wchar_t* result = malloc(sizeof(wchar_t) * bufsize); + wchar_t* result = stgMallocBytes(sizeof(wchar_t) * bufsize, "findSystemLibrary_PEi386"); DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL); if (wResult > bufsize) { @@ -755,7 +755,7 @@ pathchar* findSystemLibrary_PEi386( pathchar* dll_name ) if (!wResult) { - free(result); + stgFree(result); return NULL; } @@ -773,7 +773,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) int bufsize = init_buf_size; // Make sure the path is an absolute path - WCHAR* abs_path = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* abs_path = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(1)"); DWORD wResult = GetFullPathNameW(dll_path, bufsize, abs_path, NULL); if (!wResult){ IF_DEBUG(linker, debugBelch("addLibrarySearchPath[GetFullPathNameW]: %" PATH_FMT " (Win32 error %lu)", dll_path, GetLastError())); @@ -791,7 +791,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) else { warnMissingKBLibraryPaths(); - WCHAR* str = malloc(sizeof(WCHAR) * init_buf_size); + WCHAR* str = stgMallocBytes(sizeof(WCHAR) * init_buf_size, "addLibrarySearchPath_PEi386(2)"); wResult = GetEnvironmentVariableW(L"PATH", str, bufsize); if (wResult > init_buf_size) { @@ -804,7 +804,7 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) } bufsize = wResult + 2 + pathlen(abs_path); - wchar_t* newPath = malloc(sizeof(wchar_t) * bufsize); + wchar_t* newPath = stgMallocBytes(sizeof(wchar_t) * bufsize, "addLibrarySearchPath_PEi386(3)"); wcscpy(newPath, abs_path); wcscat(newPath, L";"); @@ -813,19 +813,19 @@ HsPtr addLibrarySearchPath_PEi386(pathchar* dll_path) sysErrorBelch("addLibrarySearchPath[SetEnvironmentVariableW]: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); } - free(newPath); - free(abs_path); + stgFree(newPath); + stgFree(abs_path); return str; } if (!result) { sysErrorBelch("addLibrarySearchPath: %" PATH_FMT " (Win32 error %lu)", abs_path, GetLastError()); - free(abs_path); + stgFree(abs_path); return NULL; } - free(abs_path); + stgFree(abs_path); return result; } ===================================== rts/win32/IOManager.c ===================================== @@ -265,7 +265,7 @@ IOWorkerProc(PVOID param) } // Free the WorkItem DeregisterWorkItem(iom,work); - free(work); + stgFree(work); } else { fprintf(stderr, "unable to fetch work; fatal.\n"); fflush(stderr); @@ -321,7 +321,7 @@ StartIOManager(void) wq = NewWorkQueue(); if ( !wq ) return false; - ioMan = (IOManagerState*)malloc(sizeof(IOManagerState)); + ioMan = (IOManagerState*)stgMallocBytes(sizeof(IOManagerState), "StartIOManager"); if (!ioMan) { FreeWorkQueue(wq); @@ -332,7 +332,7 @@ StartIOManager(void) hExit = CreateEvent ( NULL, true, false, NULL ); if ( !hExit ) { FreeWorkQueue(wq); - free(ioMan); + stgFree(ioMan); return false; } @@ -440,8 +440,7 @@ AddIORequest ( int fd, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return 0; + WorkItem* wItem = (WorkItem*)stgMallocBytse(sizeof(WorkItem), "AddIORequest"); unsigned int reqID = ioMan->requestID++; @@ -471,8 +470,7 @@ AddDelayRequest ( HsInt usecs, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); - if (!wItem) return false; + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddDelayRequest"); unsigned int reqID = ioMan->requestID++; @@ -498,7 +496,7 @@ AddProcRequest ( void* proc, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem)); + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddProcRequest"); if (!wItem) return false; unsigned int reqID = ioMan->requestID++; @@ -542,7 +540,7 @@ void ShutdownIOManager ( bool wait_threads ) barf("timeEndPeriod failed"); } - free(ioMan); + stgFree(ioMan); ioMan = NULL; } } ===================================== rts/win32/OSThreads.c ===================================== @@ -171,19 +171,19 @@ void freeThreadingResources (void) { if (cpuGroupCache) { - free(cpuGroupCache); + stgFree(cpuGroupCache); cpuGroupCache = NULL; } if (cpuGroupCumulativeCache) { - free(cpuGroupCumulativeCache); + stgFree(cpuGroupCumulativeCache); cpuGroupCumulativeCache = NULL; } if (cpuGroupDistCache) { - free(cpuGroupDistCache); + stgFree(cpuGroupDistCache); cpuGroupDistCache = NULL; } } @@ -240,7 +240,7 @@ getProcessorsDistribution (void) if (!cpuGroupDistCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupDistCache = malloc(n_groups * sizeof(uint8_t)); + cpuGroupDistCache = stgMallocBytes(n_groups * sizeof(uint8_t), "getProcessorsDistribution"); memset(cpuGroupDistCache, MAXIMUM_PROCESSORS, n_groups * sizeof(uint8_t)); for (int i = 0; i < n_groups; i++) @@ -265,7 +265,7 @@ getProcessorsCumulativeSum(void) if (!cpuGroupCumulativeCache) { uint8_t n_groups = getNumberOfProcessorsGroups(); - cpuGroupCumulativeCache = malloc(n_groups * sizeof(uint32_t)); + cpuGroupCumulativeCache = stgMallocBytes(n_groups * sizeof(uint32_t), "getProcessorsCumulativeSum"); memset(cpuGroupCumulativeCache, 0, n_groups * sizeof(uint32_t)); #if defined(x86_64_HOST_ARCH) @@ -306,7 +306,7 @@ createProcessorGroupMap (void) uint32_t numProcs = getNumberOfProcessors(); - cpuGroupCache = malloc(numProcs * sizeof(uint8_t)); + cpuGroupCache = stgMallocBytes(numProcs * sizeof(uint8_t), "createProcessorGroupMap"); /* For 32bit Windows and 64bit older than Windows 7, create a default mapping. */ memset(cpuGroupCache, 0, numProcs * sizeof(uint8_t)); @@ -386,7 +386,7 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M ASSERT(n_groups > 0); ASSERT(n_proc > 0); - mask = malloc(n_groups * sizeof(DWORD_PTR)); + mask = stgMallocBytes(n_groups * sizeof(DWORD_PTR), "setThreadAffinity"); memset(mask, 0, n_groups * sizeof(DWORD_PTR)); /* The mask for the individual groups are all 0 based @@ -422,14 +422,14 @@ setThreadAffinity (uint32_t n, uint32_t m) // cap N of M { r = SetThreadAffinityMask(hThread, mask[i]); if (r == 0) { - free(mask); + stgFree(mask); sysErrorBelch("SetThreadAffinity"); stg_exit(EXIT_FAILURE); } } } - free(mask); + stgFree(mask); } void ===================================== rts/win32/WorkQueue.c ===================================== @@ -41,12 +41,7 @@ newSemaphore(int initCount, int max) WorkQueue* NewWorkQueue() { - WorkQueue* wq = (WorkQueue*)malloc(sizeof(WorkQueue)); - - if (!wq) { - queue_error("NewWorkQueue", "malloc() failed"); - return wq; - } + WorkQueue* wq = (WorkQueue*)stgMallocBytes(sizeof(WorkQueue), "NewWorkQueue"); memset(wq, 0, sizeof *wq); ===================================== rts/xxhash.c ===================================== @@ -98,9 +98,11 @@ ***************************************/ /*! Modify the local functions below should you wish to use some other memory routines * for malloc(), free() */ -#include -static void* XXH_malloc(size_t s) { return malloc(s); } -static void XXH_free (void* p) { free(p); } +#include "Rts.h" +#include "RtsUtils.h" + +static void* XXH_malloc(size_t s) { return stgMallocBytes(s, "XXH_malloc"); } +static void XXH_free (void* p) { stgFree(p); } /*! and for memcpy() */ #include static void* XXH_memcpy(void* dest, const void* src, size_t size) { return memcpy(dest,src,size); } ===================================== testsuite/tests/ghc-api/annotations/parseTree.stdout-mingw32 deleted ===================================== @@ -1,160 +0,0 @@ -[(AnnotationTuple.hs:14:20, [p], Solo 1), - (AnnotationTuple.hs:14:23-29, [p], Solo "hello"), - (AnnotationTuple.hs:14:35-37, [p], Solo 6.5), - (AnnotationTuple.hs:14:39, [m], ()), - (AnnotationTuple.hs:14:41-52, [p], Solo [5, 5, 6, 7]), - (AnnotationTuple.hs:16:8, [p], Solo 1), - (AnnotationTuple.hs:16:11-17, [p], Solo "hello"), - (AnnotationTuple.hs:16:20-22, [p], Solo 6.5), - (AnnotationTuple.hs:16:24, [m], ()), - (AnnotationTuple.hs:16:25, [m], ()), - (AnnotationTuple.hs:16:26, [m], ()), (, [m], ())] -[ -(AK AnnotationTuple.hs:1:1 AnnCloseC = [AnnotationTuple.hs:27:1]) - -(AK AnnotationTuple.hs:1:1 AnnModule = [AnnotationTuple.hs:3:1-6]) - -(AK AnnotationTuple.hs:1:1 AnnOpenC = [AnnotationTuple.hs:5:1]) - -(AK AnnotationTuple.hs:1:1 AnnWhere = [AnnotationTuple.hs:3:30-34]) - -(AK AnnotationTuple.hs:3:24-28 AnnCloseP = [AnnotationTuple.hs:3:28]) - -(AK AnnotationTuple.hs:3:24-28 AnnOpenP = [AnnotationTuple.hs:3:24]) - -(AK AnnotationTuple.hs:6:1-32 AnnAs = [AnnotationTuple.hs:6:28-29]) - -(AK AnnotationTuple.hs:6:1-32 AnnImport = [AnnotationTuple.hs:6:1-6]) - -(AK AnnotationTuple.hs:6:1-32 AnnQualified = [AnnotationTuple.hs:6:8-16]) - -(AK AnnotationTuple.hs:6:1-32 AnnSemi = [AnnotationTuple.hs:7:1]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnEqual = [AnnotationTuple.hs:8:5]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnFunId = [AnnotationTuple.hs:8:1-3]) - -(AK AnnotationTuple.hs:(8,1)-(11,14) AnnSemi = [AnnotationTuple.hs:13:1]) - -(AK AnnotationTuple.hs:(8,7)-(11,14) AnnIn = [AnnotationTuple.hs:11:7-8]) - -(AK AnnotationTuple.hs:(8,7)-(11,14) AnnLet = [AnnotationTuple.hs:8:7-9]) - -(AK AnnotationTuple.hs:9:9-13 AnnEqual = [AnnotationTuple.hs:9:11]) - -(AK AnnotationTuple.hs:9:9-13 AnnFunId = [AnnotationTuple.hs:9:9]) - -(AK AnnotationTuple.hs:9:9-13 AnnSemi = [AnnotationTuple.hs:10:9]) - -(AK AnnotationTuple.hs:10:9-13 AnnEqual = [AnnotationTuple.hs:10:11]) - -(AK AnnotationTuple.hs:10:9-13 AnnFunId = [AnnotationTuple.hs:10:9]) - -(AK AnnotationTuple.hs:11:10-14 AnnVal = [AnnotationTuple.hs:11:12]) - -(AK AnnotationTuple.hs:14:1-72 AnnEqual = [AnnotationTuple.hs:14:5]) - -(AK AnnotationTuple.hs:14:1-72 AnnFunId = [AnnotationTuple.hs:14:1-3]) - -(AK AnnotationTuple.hs:14:1-72 AnnSemi = [AnnotationTuple.hs:15:1]) - -(AK AnnotationTuple.hs:14:7-72 AnnVal = [AnnotationTuple.hs:14:13]) - -(AK AnnotationTuple.hs:14:19-53 AnnCloseP = [AnnotationTuple.hs:14:53]) - -(AK AnnotationTuple.hs:14:19-53 AnnOpenP = [AnnotationTuple.hs:14:19]) - -(AK AnnotationTuple.hs:14:20 AnnComma = [AnnotationTuple.hs:14:21]) - -(AK AnnotationTuple.hs:14:23-29 AnnComma = [AnnotationTuple.hs:14:33]) - -(AK AnnotationTuple.hs:14:35-37 AnnComma = [AnnotationTuple.hs:14:38]) - -(AK AnnotationTuple.hs:14:39 AnnComma = [AnnotationTuple.hs:14:39]) - -(AK AnnotationTuple.hs:14:41-52 AnnCloseS = [AnnotationTuple.hs:14:52]) - -(AK AnnotationTuple.hs:14:41-52 AnnOpenS = [AnnotationTuple.hs:14:41]) - -(AK AnnotationTuple.hs:14:42 AnnComma = [AnnotationTuple.hs:14:43]) - -(AK AnnotationTuple.hs:14:45 AnnComma = [AnnotationTuple.hs:14:46]) - -(AK AnnotationTuple.hs:14:48 AnnComma = [AnnotationTuple.hs:14:49]) - -(AK AnnotationTuple.hs:14:55-72 AnnCloseS = [AnnotationTuple.hs:14:72]) - -(AK AnnotationTuple.hs:14:55-72 AnnOpenS = [AnnotationTuple.hs:14:55]) - -(AK AnnotationTuple.hs:14:56-62 AnnComma = [AnnotationTuple.hs:14:63]) - -(AK AnnotationTuple.hs:14:61-62 AnnCloseP = [AnnotationTuple.hs:14:62]) - -(AK AnnotationTuple.hs:14:61-62 AnnOpenP = [AnnotationTuple.hs:14:61]) - -(AK AnnotationTuple.hs:16:1-41 AnnEqual = [AnnotationTuple.hs:16:5]) - -(AK AnnotationTuple.hs:16:1-41 AnnFunId = [AnnotationTuple.hs:16:1-3]) - -(AK AnnotationTuple.hs:16:1-41 AnnSemi = [AnnotationTuple.hs:17:1]) - -(AK AnnotationTuple.hs:16:7-27 AnnCloseP = [AnnotationTuple.hs:16:27]) - -(AK AnnotationTuple.hs:16:7-27 AnnOpenP = [AnnotationTuple.hs:16:7]) - -(AK AnnotationTuple.hs:16:8 AnnComma = [AnnotationTuple.hs:16:9]) - -(AK AnnotationTuple.hs:16:11-17 AnnComma = [AnnotationTuple.hs:16:18]) - -(AK AnnotationTuple.hs:16:20-22 AnnComma = [AnnotationTuple.hs:16:23]) - -(AK AnnotationTuple.hs:16:24 AnnComma = [AnnotationTuple.hs:16:24]) - -(AK AnnotationTuple.hs:16:25 AnnComma = [AnnotationTuple.hs:16:25]) - -(AK AnnotationTuple.hs:16:26 AnnComma = [AnnotationTuple.hs:16:26]) - -(AK AnnotationTuple.hs:16:33-41 AnnCloseP = [AnnotationTuple.hs:16:41]) - -(AK AnnotationTuple.hs:16:33-41 AnnOpenP = [AnnotationTuple.hs:16:33]) - -(AK AnnotationTuple.hs:16:39-40 AnnCloseP = [AnnotationTuple.hs:16:40]) - -(AK AnnotationTuple.hs:16:39-40 AnnOpenP = [AnnotationTuple.hs:16:39]) - -(AK AnnotationTuple.hs:18:1-28 AnnData = [AnnotationTuple.hs:18:1-4]) - -(AK AnnotationTuple.hs:18:1-28 AnnDcolon = [AnnotationTuple.hs:18:20-21]) - -(AK AnnotationTuple.hs:18:1-28 AnnFamily = [AnnotationTuple.hs:18:6-11]) - -(AK AnnotationTuple.hs:18:1-28 AnnSemi = [AnnotationTuple.hs:19:1]) - -(AK AnnotationTuple.hs:18:23 AnnRarrow = [AnnotationTuple.hs:18:25-26]) - -(AK AnnotationTuple.hs:18:23-28 AnnRarrow = [AnnotationTuple.hs:18:25-26]) - -(AK AnnotationTuple.hs:(20,1)-(24,14) AnnFunId = [AnnotationTuple.hs:20:1-5]) - -(AK AnnotationTuple.hs:(20,1)-(24,14) AnnSemi = [AnnotationTuple.hs:25:1]) - -(AK AnnotationTuple.hs:(21,7)-(24,14) AnnEqual = [AnnotationTuple.hs:24:7]) - -(AK AnnotationTuple.hs:(21,7)-(24,14) AnnVbar = [AnnotationTuple.hs:21:7]) - -(AK AnnotationTuple.hs:21:9-24 AnnComma = [AnnotationTuple.hs:22:7]) - -(AK AnnotationTuple.hs:21:9-24 AnnLarrow = [AnnotationTuple.hs:21:16-17]) - -(AK AnnotationTuple.hs:22:9-25 AnnComma = [AnnotationTuple.hs:23:7]) - -(AK AnnotationTuple.hs:22:9-25 AnnLarrow = [AnnotationTuple.hs:22:16-17]) - -(AK AnnotationTuple.hs:23:9-24 AnnLarrow = [AnnotationTuple.hs:23:16-17]) - -(AK AnnotationTuple.hs:26:1-10 AnnDcolon = [AnnotationTuple.hs:26:5-6]) - -(AK AnnotationTuple.hs:26:1-14 AnnEqual = [AnnotationTuple.hs:26:12]) -] - -EOF: Just SrcSpanPoint ".\\AnnotationTuple.hs" 32 1 ===================================== testsuite/tests/ghci/scripts/all.T ===================================== @@ -141,8 +141,11 @@ test('T5979', normalise_slashes, normalise_version("transformers")], ghci_script, ['T5979.script']) -test('T5975a', [pre_cmd('touch föøbàr1.hs')], ghci_script, ['T5975a.script']) -test('T5975b', [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs')], +test('T5975a', + [pre_cmd('touch föøbàr1.hs'), when(opsys('mingw32'), expect_broken(7305))], + ghci_script, ['T5975a.script']) +test('T5975b', + [pre_cmd('touch föøbàr2.hs'), extra_hc_opts('föøbàr2.hs'), when(opsys('mingw32'), expect_broken(7305))], ghci_script, ['T5975b.script']) test('T6027ghci', normal, ghci_script, ['T6027ghci.script']) ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -1,4 +1,3 @@ mod184.hs:6:8: warning: [-Wprepositive-qualified-module] Found ‘qualified’ in prepositive position Suggested fix: place ‘qualified’ after the module name instead. - To allow this, enable language extension 'ImportQualifiedPost' ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a072f5aa908c61b0dcdcb79c3ff6d51b021ac04e...b32c4a0fda3396b7b72d8ad3a4b67b1797f465c8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a072f5aa908c61b0dcdcb79c3ff6d51b021ac04e...b32c4a0fda3396b7b72d8ad3a4b67b1797f465c8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 10:49:50 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 07 Sep 2020 06:49:50 -0400 Subject: [Git][ghc/ghc][wip/T18645] Make `tcCheckSatisfiability` incremental (#18645) Message-ID: <5f56104e6494a_80b3f8438deee401084014d@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 at Glasgow Haskell Compiler / GHC Commits: d4347d90 by Sebastian Graf at 2020-09-07T12:47:10+02:00 Make `tcCheckSatisfiability` incremental (#18645) By taking and returning an `InertSet`. Every new `TcS` session can then pick up where a prior session left with `setTcSInerts`. Since we don't want to unflatten the Givens (and because it leads to infinite loops, see !3971), we introduced a new variant of `runTcS`, `runTcSInerts`, that takes and returns the `InertSet` and makes sure not to unflatten the Givens after running the `TcS` action. Fixes #18645 and (hopefully) #17836. - - - - - 4 changed files: - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -523,13 +523,11 @@ nameTyCt pred_ty = do tyOracle :: TyState -> Bag PredType -> DsM (Maybe TyState) tyOracle (TySt inert) cts = do { evs <- traverse nameTyCt cts - ; let new_inert = inert `unionBags` evs ; tracePm "tyOracle" (ppr cts) - ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability new_inert + ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability inert evs ; case res of - Just True -> return (Just (TySt new_inert)) - Just False -> return Nothing - Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } + Just mb_new_inert -> return (TySt <$> mb_new_inert) + Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -47,7 +47,6 @@ import GHC.Prelude import GHC.Utils.Misc import GHC.Data.Bag import GHC.Data.FastString -import GHC.Types.Var (EvVar) import GHC.Types.Id import GHC.Types.Var.Env import GHC.Types.Unique.DSet @@ -68,7 +67,7 @@ import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim -import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Tc.Solver.Monad (InertSet, emptyInert) import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) @@ -596,15 +595,14 @@ initTmState = TmSt emptySDIE emptyCoreMap -- | The type oracle state. A poor man's 'GHC.Tc.Solver.Monad.InsertSet': The invariant is -- that all constraints in there are mutually compatible. -newtype TyState = TySt (Bag EvVar) +newtype TyState = TySt InertSet -- | Not user-facing. instance Outputable TyState where - ppr (TySt evs) - = braces $ hcat $ punctuate comma $ map (ppr . evVarPred) $ bagToList evs + ppr (TySt inert) = ppr inert initTyState :: TyState -initTyState = TySt emptyBag +initTyState = TySt emptyInert -- | A normalised refinement type ∇ (\"nabla\"), comprised of an inert set of -- canonical (i.e. mutually compatible) term and type constraints that form the ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -718,22 +718,22 @@ simplifyDefault theta ; return () } ------------------ -tcCheckSatisfiability :: Bag EvVar -> TcM Bool --- Return True if satisfiable, False if definitely contradictory -tcCheckSatisfiability given_ids - = do { lcl_env <- TcM.getLclEnv - ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env - ; (res, _ev_binds) <- runTcS $ - do { traceTcS "checkSatisfiability {" (ppr given_ids) - ; let given_cts = mkGivens given_loc (bagToList given_ids) - -- See Note [Superclasses and satisfiability] - ; solveSimpleGivens given_cts - ; insols <- getInertInsols - ; insols <- try_harder insols - ; traceTcS "checkSatisfiability }" (ppr insols) - ; return (isEmptyBag insols) } - ; return res } - where +tcCheckSatisfiability :: InertSet -> Bag EvVar -> TcM (Maybe InertSet) +-- Return (Just new_inerts) if satisfiable, Nothing if definitely contradictory +tcCheckSatisfiability inerts given_ids = do + (sat, new_inerts) <- runTcSInerts inerts $ do + traceTcS "checkSatisfiability {" (ppr inerts <+> ppr given_ids) + lcl_env <- TcS.getLclEnv + let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env + let given_cts = mkGivens given_loc (bagToList given_ids) + -- See Note [Superclasses and satisfiability] + solveSimpleGivens given_cts + insols <- getInertInsols + insols <- try_harder insols + traceTcS "checkSatisfiability }" (ppr insols) + return (isEmptyBag insols) + return $ if sat then Just new_inerts else Nothing + where try_harder :: Cts -> TcS Cts -- Maybe we have to search up the superclass chain to find -- an unsatisfiable constraint. Example: pmcheck/T3927b. @@ -749,15 +749,11 @@ tcCheckSatisfiability given_ids -- | Normalise a type as much as possible using the given constraints. -- See @Note [tcNormalise]@. -tcNormalise :: Bag EvVar -> Type -> TcM Type -tcNormalise given_ids ty - = do { lcl_env <- TcM.getLclEnv - ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env - ; norm_loc <- getCtLocM PatCheckOrigin Nothing - ; (res, _ev_binds) <- runTcS $ - do { traceTcS "tcNormalise {" (ppr given_ids) - ; let given_cts = mkGivens given_loc (bagToList given_ids) - ; solveSimpleGivens given_cts +tcNormalise :: InertSet -> Type -> TcM Type +tcNormalise inerts ty + = do { norm_loc <- getCtLocM PatCheckOrigin Nothing + ; (res, _new_inerts) <- runTcSInerts inerts $ + do { traceTcS "tcNormalise {" (ppr inerts) ; ty' <- flattenType norm_loc ty ; traceTcS "tcNormalise }" (ppr ty') ; pure ty' } @@ -788,8 +784,9 @@ Note [tcNormalise] tcNormalise is a rather atypical entrypoint to the constraint solver. Whereas most invocations of the constraint solver are intended to simplify a set of constraints or to decide if a particular set of constraints is satisfiable, -the purpose of tcNormalise is to take a type, plus some local constraints, and -normalise the type as much as possible with respect to those constraints. +the purpose of tcNormalise is to take a type, plus some locally solved +constraints in the form of an InertCans, and normalise the type as much as +possible with respect to those constraints. It does *not* reduce type or data family applications or look through newtypes. @@ -798,9 +795,9 @@ expression, it's possible that the type of the scrutinee will only reduce if some local equalities are solved for. See "Wrinkle: Local equalities" in Note [Type normalisation] in "GHC.HsToCore.PmCheck". -To accomplish its stated goal, tcNormalise first feeds the local constraints -into solveSimpleGivens, then uses flattenType to simplify the desired type -with respect to the givens. +To accomplish its stated goal, tcNormalise first initialises the solver monad +with the given InertCans, then uses flattenType to simplify the desired type +with respect to the Givens in the InertCans. *********************************************************************************** * * @@ -893,7 +890,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds ; psig_theta_vars <- mapM TcM.newEvVar psig_theta ; wanted_transformed_incl_derivs <- setTcLevel rhs_tclvl $ - runTcSWithEvBinds ev_binds_var $ + runTcSWithEvBinds ev_binds_var True $ do { let loc = mkGivenLoc rhs_tclvl UnkSkol $ env_lcl tc_env psig_givens = mkGivens loc psig_theta_vars ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Tc.Solver.Monad ( getWorkList, updWorkListTcS, pushLevelNoWorkList, -- The TcS monad - TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, + TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, runTcSInerts, failTcS, warnTcS, addErrTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, @@ -55,7 +55,7 @@ module GHC.Tc.Solver.Monad ( tcLookupClass, tcLookupId, -- Inerts - InertSet(..), InertCans(..), + InertSet(..), InertCans(..), emptyInert, updInertTcS, updInertCans, updInertDicts, updInertIrreds, getNoGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, @@ -2785,28 +2785,41 @@ runTcS :: TcS a -- What to run -> TcM (a, EvBindMap) runTcS tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; res <- runTcSWithEvBinds ev_binds_var tcs + ; res <- runTcSWithEvBinds ev_binds_var True tcs ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var ; return (res, ev_binds) } - -- | This variant of 'runTcS' will keep solving, even when only Deriveds -- are left around. It also doesn't return any evidence, as callers won't -- need it. runTcSDeriveds :: TcS a -> TcM a runTcSDeriveds tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; runTcSWithEvBinds ev_binds_var tcs } + ; runTcSWithEvBinds ev_binds_var True tcs } -- | This can deal only with equality constraints. runTcSEqualities :: TcS a -> TcM a runTcSEqualities thing_inside = do { ev_binds_var <- TcM.newNoTcEvBinds - ; runTcSWithEvBinds ev_binds_var thing_inside } + ; runTcSWithEvBinds ev_binds_var True thing_inside } + +-- | A variant of 'runTcS' that takes and returns an 'InertSet' for +-- later resumption of the 'TcS' session. Crucially, it doesn't +-- 'unflattenGivens' when done. +runTcSInerts :: InertSet -> TcS a -> TcM (a, InertSet) +runTcSInerts inerts tcs = do + ev_binds_var <- TcM.newTcEvBinds + -- Passing False here to prohibit unflattening + runTcSWithEvBinds ev_binds_var False $ do + setTcSInerts inerts + a <- tcs + new_inerts <- getTcSInerts + return (a, new_inerts) runTcSWithEvBinds :: EvBindsVar + -> Bool -- ^ Unflatten types afterwards? Don't if you want to reuse the InertSet. -> TcS a -> TcM a -runTcSWithEvBinds ev_binds_var tcs +runTcSWithEvBinds ev_binds_var unflatten tcs = do { unified_var <- TcM.newTcRef 0 ; step_count <- TcM.newTcRef 0 ; inert_var <- TcM.newTcRef emptyInert @@ -2824,7 +2837,7 @@ runTcSWithEvBinds ev_binds_var tcs ; when (count > 0) $ csTraceTcM $ return (text "Constraint solver steps =" <+> int count) - ; unflattenGivens inert_var + ; when unflatten $ unflattenGivens inert_var #if defined(DEBUG) ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4347d90302566baf75d58e1885bec8a0b127654 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d4347d90302566baf75d58e1885bec8a0b127654 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 13:34:00 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 07 Sep 2020 09:34:00 -0400 Subject: [Git][ghc/ghc][master] Add clarification regarding poll/kqueue flags Message-ID: <5f5636c8977c3_80b3f8486abcd141085473e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 1 changed file: - libraries/base/configure.ac Changes: ===================================== libraries/base/configure.ac ===================================== @@ -47,9 +47,13 @@ AC_CHECK_FUNCS([clock_gettime]) AC_CHECK_FUNCS([getclock getrusage times]) AC_CHECK_FUNCS([_chsize ftruncate]) -AC_CHECK_FUNCS([epoll_ctl eventfd kevent kevent64 kqueue poll]) - # event-related fun +# The line below already defines HAVE_KQUEUE and HAVE_POLL, so technically some of the +# subsequent portions that redefine them could be skipped. However, we keep those portions +# to keep kqueue/poll in line with HAVE_EPOLL and possible other additions in the future. You +# should be aware of this peculiarity if you try to simulate not having kqueue or poll by +# moving away header files (see also https://gitlab.haskell.org/ghc/ghc/-/issues/9283) +AC_CHECK_FUNCS([epoll_ctl eventfd kevent kevent64 kqueue poll]) if test "$ac_cv_header_sys_epoll_h" = yes && test "$ac_cv_func_epoll_ctl" = yes; then AC_DEFINE([HAVE_EPOLL], [1], [Define if you have epoll support.]) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5413fc62342f05d48e62f92c81a7f8a3259d3d7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c5413fc62342f05d48e62f92c81a7f8a3259d3d7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 13:34:45 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 07 Sep 2020 09:34:45 -0400 Subject: [Git][ghc/ghc][master] 2 commits: gitlab-ci: Configure bignum backend in Hadrian builds Message-ID: <5f5636f54a444_80b8245f101086003d@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -856,13 +856,16 @@ validate-x86_64-linux-fedora27: - ghc.tar.xz - junit.xml -validate-x86_64-windows-hadrian: +.build-x86_64-windows-hadrian: extends: .build-windows-hadrian variables: MSYSTEM: MINGW64 - TEST_ENV: "x86_64-windows-hadrian" + TEST_ENV: "x86_64-windows" cache: - key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" + key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" + +validate-x86_64-windows-hadrian: + extends: .build-x86_64-windows-hadrian .build-windows-make: extends: .build-windows @@ -903,16 +906,17 @@ nightly-x86_64-windows: variables: BUILD_FLAVOUR: "validate" -# Normal Windows validate builds are profiled; that won't do for releases. +# Normal Windows validate builds lack profiled libraries; that won't do for +# releases. release-x86_64-windows: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BUILD_FLAVOUR: "perf" - # + release-x86_64-windows-integer-simple: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" ===================================== .gitlab/ci.sh ===================================== @@ -427,10 +427,12 @@ function clean() { } function run_hadrian() { + if [ -z "$BIGNUM_BACKEND" ]; then BIGNUM_BACKEND="gmp"; fi run hadrian/build-cabal \ --flavour="$FLAVOUR" \ -j"$cores" \ --broken-test="$BROKEN_TESTS" \ + --bignum=$BIGNUM_BACKEND \ $HADRIAN_ARGS \ $@ } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5413fc62342f05d48e62f92c81a7f8a3259d3d7...d4bc9f0de7992f60bce403731019829f6248cc2c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c5413fc62342f05d48e62f92c81a7f8a3259d3d7...d4bc9f0de7992f60bce403731019829f6248cc2c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 13:41:57 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 07 Sep 2020 09:41:57 -0400 Subject: [Git][ghc/ghc][wip/T18645] Make `tcCheckSatisfiability` incremental (#18645) Message-ID: <5f5638a5de63_80badc81241086397d@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 at Glasgow Haskell Compiler / GHC Commits: 470d94b0 by Sebastian Graf at 2020-09-07T15:41:24+02:00 Make `tcCheckSatisfiability` incremental (#18645) By taking and returning an `InertSet`. Every new `TcS` session can then pick up where a prior session left with `setTcSInerts`. Since we don't want to unflatten the Givens (and because it leads to infinite loops, see !3971), we introduced a new variant of `runTcS`, `runTcSInerts`, that takes and returns the `InertSet` and makes sure not to unflatten the Givens after running the `TcS` action. Fixes #18645 and #17836. Metric Decrease: T17977b - - - - - 7 changed files: - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - + testsuite/tests/pmcheck/should_compile/T17836.hs - + testsuite/tests/pmcheck/should_compile/T17836b.hs - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -523,13 +523,11 @@ nameTyCt pred_ty = do tyOracle :: TyState -> Bag PredType -> DsM (Maybe TyState) tyOracle (TySt inert) cts = do { evs <- traverse nameTyCt cts - ; let new_inert = inert `unionBags` evs ; tracePm "tyOracle" (ppr cts) - ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability new_inert + ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability inert evs ; case res of - Just True -> return (Just (TySt new_inert)) - Just False -> return Nothing - Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } + Just mb_new_inert -> return (TySt <$> mb_new_inert) + Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -47,7 +47,6 @@ import GHC.Prelude import GHC.Utils.Misc import GHC.Data.Bag import GHC.Data.FastString -import GHC.Types.Var (EvVar) import GHC.Types.Id import GHC.Types.Var.Env import GHC.Types.Unique.DSet @@ -68,7 +67,7 @@ import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim -import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Tc.Solver.Monad (InertSet, emptyInert) import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) @@ -596,15 +595,14 @@ initTmState = TmSt emptySDIE emptyCoreMap -- | The type oracle state. A poor man's 'GHC.Tc.Solver.Monad.InsertSet': The invariant is -- that all constraints in there are mutually compatible. -newtype TyState = TySt (Bag EvVar) +newtype TyState = TySt InertSet -- | Not user-facing. instance Outputable TyState where - ppr (TySt evs) - = braces $ hcat $ punctuate comma $ map (ppr . evVarPred) $ bagToList evs + ppr (TySt inert) = ppr inert initTyState :: TyState -initTyState = TySt emptyBag +initTyState = TySt emptyInert -- | A normalised refinement type ∇ (\"nabla\"), comprised of an inert set of -- canonical (i.e. mutually compatible) term and type constraints that form the ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -718,22 +718,22 @@ simplifyDefault theta ; return () } ------------------ -tcCheckSatisfiability :: Bag EvVar -> TcM Bool --- Return True if satisfiable, False if definitely contradictory -tcCheckSatisfiability given_ids - = do { lcl_env <- TcM.getLclEnv - ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env - ; (res, _ev_binds) <- runTcS $ - do { traceTcS "checkSatisfiability {" (ppr given_ids) - ; let given_cts = mkGivens given_loc (bagToList given_ids) - -- See Note [Superclasses and satisfiability] - ; solveSimpleGivens given_cts - ; insols <- getInertInsols - ; insols <- try_harder insols - ; traceTcS "checkSatisfiability }" (ppr insols) - ; return (isEmptyBag insols) } - ; return res } - where +tcCheckSatisfiability :: InertSet -> Bag EvVar -> TcM (Maybe InertSet) +-- Return (Just new_inerts) if satisfiable, Nothing if definitely contradictory +tcCheckSatisfiability inerts given_ids = do + (sat, new_inerts) <- runTcSInerts inerts $ do + traceTcS "checkSatisfiability {" (ppr inerts <+> ppr given_ids) + lcl_env <- TcS.getLclEnv + let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env + let given_cts = mkGivens given_loc (bagToList given_ids) + -- See Note [Superclasses and satisfiability] + solveSimpleGivens given_cts + insols <- getInertInsols + insols <- try_harder insols + traceTcS "checkSatisfiability }" (ppr insols) + return (isEmptyBag insols) + return $ if sat then Just new_inerts else Nothing + where try_harder :: Cts -> TcS Cts -- Maybe we have to search up the superclass chain to find -- an unsatisfiable constraint. Example: pmcheck/T3927b. @@ -749,15 +749,11 @@ tcCheckSatisfiability given_ids -- | Normalise a type as much as possible using the given constraints. -- See @Note [tcNormalise]@. -tcNormalise :: Bag EvVar -> Type -> TcM Type -tcNormalise given_ids ty - = do { lcl_env <- TcM.getLclEnv - ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env - ; norm_loc <- getCtLocM PatCheckOrigin Nothing - ; (res, _ev_binds) <- runTcS $ - do { traceTcS "tcNormalise {" (ppr given_ids) - ; let given_cts = mkGivens given_loc (bagToList given_ids) - ; solveSimpleGivens given_cts +tcNormalise :: InertSet -> Type -> TcM Type +tcNormalise inerts ty + = do { norm_loc <- getCtLocM PatCheckOrigin Nothing + ; (res, _new_inerts) <- runTcSInerts inerts $ + do { traceTcS "tcNormalise {" (ppr inerts) ; ty' <- flattenType norm_loc ty ; traceTcS "tcNormalise }" (ppr ty') ; pure ty' } @@ -788,8 +784,9 @@ Note [tcNormalise] tcNormalise is a rather atypical entrypoint to the constraint solver. Whereas most invocations of the constraint solver are intended to simplify a set of constraints or to decide if a particular set of constraints is satisfiable, -the purpose of tcNormalise is to take a type, plus some local constraints, and -normalise the type as much as possible with respect to those constraints. +the purpose of tcNormalise is to take a type, plus some locally solved +constraints in the form of an InertSet, and normalise the type as much as +possible with respect to those constraints. It does *not* reduce type or data family applications or look through newtypes. @@ -798,9 +795,9 @@ expression, it's possible that the type of the scrutinee will only reduce if some local equalities are solved for. See "Wrinkle: Local equalities" in Note [Type normalisation] in "GHC.HsToCore.PmCheck". -To accomplish its stated goal, tcNormalise first feeds the local constraints -into solveSimpleGivens, then uses flattenType to simplify the desired type -with respect to the givens. +To accomplish its stated goal, tcNormalise first initialises the solver monad +with the given InertCans, then uses flattenType to simplify the desired type +with respect to the Givens in the InertCans. *********************************************************************************** * * @@ -893,7 +890,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds ; psig_theta_vars <- mapM TcM.newEvVar psig_theta ; wanted_transformed_incl_derivs <- setTcLevel rhs_tclvl $ - runTcSWithEvBinds ev_binds_var $ + runTcSWithEvBinds ev_binds_var True $ do { let loc = mkGivenLoc rhs_tclvl UnkSkol $ env_lcl tc_env psig_givens = mkGivens loc psig_theta_vars ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Tc.Solver.Monad ( getWorkList, updWorkListTcS, pushLevelNoWorkList, -- The TcS monad - TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, + TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, runTcSInerts, failTcS, warnTcS, addErrTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, @@ -55,7 +55,7 @@ module GHC.Tc.Solver.Monad ( tcLookupClass, tcLookupId, -- Inerts - InertSet(..), InertCans(..), + InertSet(..), InertCans(..), emptyInert, updInertTcS, updInertCans, updInertDicts, updInertIrreds, getNoGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, @@ -2785,28 +2785,41 @@ runTcS :: TcS a -- What to run -> TcM (a, EvBindMap) runTcS tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; res <- runTcSWithEvBinds ev_binds_var tcs + ; res <- runTcSWithEvBinds ev_binds_var True tcs ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var ; return (res, ev_binds) } - -- | This variant of 'runTcS' will keep solving, even when only Deriveds -- are left around. It also doesn't return any evidence, as callers won't -- need it. runTcSDeriveds :: TcS a -> TcM a runTcSDeriveds tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; runTcSWithEvBinds ev_binds_var tcs } + ; runTcSWithEvBinds ev_binds_var True tcs } -- | This can deal only with equality constraints. runTcSEqualities :: TcS a -> TcM a runTcSEqualities thing_inside = do { ev_binds_var <- TcM.newNoTcEvBinds - ; runTcSWithEvBinds ev_binds_var thing_inside } + ; runTcSWithEvBinds ev_binds_var True thing_inside } + +-- | A variant of 'runTcS' that takes and returns an 'InertSet' for +-- later resumption of the 'TcS' session. Crucially, it doesn't +-- 'unflattenGivens' when done. +runTcSInerts :: InertSet -> TcS a -> TcM (a, InertSet) +runTcSInerts inerts tcs = do + ev_binds_var <- TcM.newTcEvBinds + -- Passing False here to prohibit unflattening + runTcSWithEvBinds ev_binds_var False $ do + setTcSInerts inerts + a <- tcs + new_inerts <- getTcSInerts + return (a, new_inerts) runTcSWithEvBinds :: EvBindsVar + -> Bool -- ^ Unflatten types afterwards? Don't if you want to reuse the InertSet. -> TcS a -> TcM a -runTcSWithEvBinds ev_binds_var tcs +runTcSWithEvBinds ev_binds_var unflatten tcs = do { unified_var <- TcM.newTcRef 0 ; step_count <- TcM.newTcRef 0 ; inert_var <- TcM.newTcRef emptyInert @@ -2824,7 +2837,7 @@ runTcSWithEvBinds ev_binds_var tcs ; when (count > 0) $ csTraceTcM $ return (text "Constraint solver steps =" <+> int count) - ; unflattenGivens inert_var + ; when unflatten $ unflattenGivens inert_var #if defined(DEBUG) ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var ===================================== testsuite/tests/pmcheck/should_compile/T17836.hs ===================================== @@ -0,0 +1,96 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE PatternSynonyms #-} +module PM where + +import Data.Type.Equality ( type (:~:)(..) ) + +data Type :: * -> * where + SRecNil :: Type () + SRecCons :: String -> Type a -> Type b -> Type (a, b) + SIntTy :: Type Int + +pattern RecCons1 a <- (SRecCons _ _ a) + +eqType :: Type ty1 -> Type ty2 -> Maybe (ty1 :~: ty2) +eqType SRecNil SRecNil = Just Refl +eqType (SRecCons l1 s1 t1) (SRecCons l2 s2 t2) + | Just Refl <- s1 `eqType` s2 + , Just Refl <- t1 `eqType` t2 + , l1 == l2 + = Just Refl +eqType SIntTy SIntTy = Just Refl +eqType _ _ = Nothing + +massive :: Int -> Type ty -> Type recty -> (forall ty'. Type ty' -> m r) -> m r +massive fieldN sFieldTy sRecTy k = + case (fieldN, sFieldTy, sRecTy) of + (0, t, SRecCons _ t' _) + | Just Refl <- t `eqType` t' -> k sFieldTy + (1, t, RecCons1 (SRecCons _ t' _)) + | Just Refl <- t `eqType` t' -> k sFieldTy + (2, t, RecCons1 (RecCons1 (SRecCons _ t' _))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (3, t, RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (4, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (5, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (6, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (7, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (8, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (9, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (10, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (11, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (12, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (13, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (14, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (15, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (16, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (17, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (18, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (19, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (20, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (21, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (22, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (23, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (24, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (25, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (26, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (27, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (28, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (29, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (30, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (31, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (32, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + _ -> error "TODO support records >32" ===================================== testsuite/tests/pmcheck/should_compile/T17836b.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +module PM where + +data T a where + T :: T b -> T (a, b) + +pattern P a <- (T a) + +massive :: T recty -> () +massive (P (P (P (P (P (P (P (P (P (P (P (P (P (P (P (P (P _))))))))))))))))) = () ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -124,6 +124,12 @@ test('T17729', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17783', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17836', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17836b', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17977b', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17977', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17977b', collect_compiler_stats('bytes allocated',10), compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/470d94b068e6779743a462628dd8622d89689339 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/470d94b068e6779743a462628dd8622d89689339 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 13:52:45 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 07 Sep 2020 09:52:45 -0400 Subject: [Git][ghc/ghc][wip/T18645] Make `tcCheckSatisfiability` incremental (#18645) Message-ID: <5f563b2d49f54_80b3f8468c6d7f810864853@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 at Glasgow Haskell Compiler / GHC Commits: 9da539b9 by Sebastian Graf at 2020-09-07T15:52:29+02:00 Make `tcCheckSatisfiability` incremental (#18645) By taking and returning an `InertSet`. Every new `TcS` session can then pick up where a prior session left with `setTcSInerts`. Since we don't want to unflatten the Givens (and because it leads to infinite loops, see !3971), we introduced a new variant of `runTcS`, `runTcSInerts`, that takes and returns the `InertSet` and makes sure not to unflatten the Givens after running the `TcS` action. Fixes #18645 and #17836. Metric Decrease: T17977b - - - - - 8 changed files: - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - + testsuite/tests/pmcheck/should_compile/T17836.hs - + testsuite/tests/pmcheck/should_compile/T17836b.hs - + testsuite/tests/pmcheck/should_compile/T17836b.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -523,13 +523,11 @@ nameTyCt pred_ty = do tyOracle :: TyState -> Bag PredType -> DsM (Maybe TyState) tyOracle (TySt inert) cts = do { evs <- traverse nameTyCt cts - ; let new_inert = inert `unionBags` evs ; tracePm "tyOracle" (ppr cts) - ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability new_inert + ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability inert evs ; case res of - Just True -> return (Just (TySt new_inert)) - Just False -> return Nothing - Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } + Just mb_new_inert -> return (TySt <$> mb_new_inert) + Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -47,7 +47,6 @@ import GHC.Prelude import GHC.Utils.Misc import GHC.Data.Bag import GHC.Data.FastString -import GHC.Types.Var (EvVar) import GHC.Types.Id import GHC.Types.Var.Env import GHC.Types.Unique.DSet @@ -68,7 +67,7 @@ import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim -import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Tc.Solver.Monad (InertSet, emptyInert) import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) @@ -596,15 +595,14 @@ initTmState = TmSt emptySDIE emptyCoreMap -- | The type oracle state. A poor man's 'GHC.Tc.Solver.Monad.InsertSet': The invariant is -- that all constraints in there are mutually compatible. -newtype TyState = TySt (Bag EvVar) +newtype TyState = TySt InertSet -- | Not user-facing. instance Outputable TyState where - ppr (TySt evs) - = braces $ hcat $ punctuate comma $ map (ppr . evVarPred) $ bagToList evs + ppr (TySt inert) = ppr inert initTyState :: TyState -initTyState = TySt emptyBag +initTyState = TySt emptyInert -- | A normalised refinement type ∇ (\"nabla\"), comprised of an inert set of -- canonical (i.e. mutually compatible) term and type constraints that form the ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -718,22 +718,22 @@ simplifyDefault theta ; return () } ------------------ -tcCheckSatisfiability :: Bag EvVar -> TcM Bool --- Return True if satisfiable, False if definitely contradictory -tcCheckSatisfiability given_ids - = do { lcl_env <- TcM.getLclEnv - ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env - ; (res, _ev_binds) <- runTcS $ - do { traceTcS "checkSatisfiability {" (ppr given_ids) - ; let given_cts = mkGivens given_loc (bagToList given_ids) - -- See Note [Superclasses and satisfiability] - ; solveSimpleGivens given_cts - ; insols <- getInertInsols - ; insols <- try_harder insols - ; traceTcS "checkSatisfiability }" (ppr insols) - ; return (isEmptyBag insols) } - ; return res } - where +tcCheckSatisfiability :: InertSet -> Bag EvVar -> TcM (Maybe InertSet) +-- Return (Just new_inerts) if satisfiable, Nothing if definitely contradictory +tcCheckSatisfiability inerts given_ids = do + (sat, new_inerts) <- runTcSInerts inerts $ do + traceTcS "checkSatisfiability {" (ppr inerts <+> ppr given_ids) + lcl_env <- TcS.getLclEnv + let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env + let given_cts = mkGivens given_loc (bagToList given_ids) + -- See Note [Superclasses and satisfiability] + solveSimpleGivens given_cts + insols <- getInertInsols + insols <- try_harder insols + traceTcS "checkSatisfiability }" (ppr insols) + return (isEmptyBag insols) + return $ if sat then Just new_inerts else Nothing + where try_harder :: Cts -> TcS Cts -- Maybe we have to search up the superclass chain to find -- an unsatisfiable constraint. Example: pmcheck/T3927b. @@ -749,15 +749,11 @@ tcCheckSatisfiability given_ids -- | Normalise a type as much as possible using the given constraints. -- See @Note [tcNormalise]@. -tcNormalise :: Bag EvVar -> Type -> TcM Type -tcNormalise given_ids ty - = do { lcl_env <- TcM.getLclEnv - ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env - ; norm_loc <- getCtLocM PatCheckOrigin Nothing - ; (res, _ev_binds) <- runTcS $ - do { traceTcS "tcNormalise {" (ppr given_ids) - ; let given_cts = mkGivens given_loc (bagToList given_ids) - ; solveSimpleGivens given_cts +tcNormalise :: InertSet -> Type -> TcM Type +tcNormalise inerts ty + = do { norm_loc <- getCtLocM PatCheckOrigin Nothing + ; (res, _new_inerts) <- runTcSInerts inerts $ + do { traceTcS "tcNormalise {" (ppr inerts) ; ty' <- flattenType norm_loc ty ; traceTcS "tcNormalise }" (ppr ty') ; pure ty' } @@ -788,8 +784,9 @@ Note [tcNormalise] tcNormalise is a rather atypical entrypoint to the constraint solver. Whereas most invocations of the constraint solver are intended to simplify a set of constraints or to decide if a particular set of constraints is satisfiable, -the purpose of tcNormalise is to take a type, plus some local constraints, and -normalise the type as much as possible with respect to those constraints. +the purpose of tcNormalise is to take a type, plus some locally solved +constraints in the form of an InertSet, and normalise the type as much as +possible with respect to those constraints. It does *not* reduce type or data family applications or look through newtypes. @@ -798,9 +795,9 @@ expression, it's possible that the type of the scrutinee will only reduce if some local equalities are solved for. See "Wrinkle: Local equalities" in Note [Type normalisation] in "GHC.HsToCore.PmCheck". -To accomplish its stated goal, tcNormalise first feeds the local constraints -into solveSimpleGivens, then uses flattenType to simplify the desired type -with respect to the givens. +To accomplish its stated goal, tcNormalise first initialises the solver monad +with the given InertCans, then uses flattenType to simplify the desired type +with respect to the Givens in the InertCans. *********************************************************************************** * * @@ -893,7 +890,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds ; psig_theta_vars <- mapM TcM.newEvVar psig_theta ; wanted_transformed_incl_derivs <- setTcLevel rhs_tclvl $ - runTcSWithEvBinds ev_binds_var $ + runTcSWithEvBinds ev_binds_var True $ do { let loc = mkGivenLoc rhs_tclvl UnkSkol $ env_lcl tc_env psig_givens = mkGivens loc psig_theta_vars ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Tc.Solver.Monad ( getWorkList, updWorkListTcS, pushLevelNoWorkList, -- The TcS monad - TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, + TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, runTcSInerts, failTcS, warnTcS, addErrTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, @@ -55,7 +55,7 @@ module GHC.Tc.Solver.Monad ( tcLookupClass, tcLookupId, -- Inerts - InertSet(..), InertCans(..), + InertSet(..), InertCans(..), emptyInert, updInertTcS, updInertCans, updInertDicts, updInertIrreds, getNoGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, @@ -2785,28 +2785,41 @@ runTcS :: TcS a -- What to run -> TcM (a, EvBindMap) runTcS tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; res <- runTcSWithEvBinds ev_binds_var tcs + ; res <- runTcSWithEvBinds ev_binds_var True tcs ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var ; return (res, ev_binds) } - -- | This variant of 'runTcS' will keep solving, even when only Deriveds -- are left around. It also doesn't return any evidence, as callers won't -- need it. runTcSDeriveds :: TcS a -> TcM a runTcSDeriveds tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; runTcSWithEvBinds ev_binds_var tcs } + ; runTcSWithEvBinds ev_binds_var True tcs } -- | This can deal only with equality constraints. runTcSEqualities :: TcS a -> TcM a runTcSEqualities thing_inside = do { ev_binds_var <- TcM.newNoTcEvBinds - ; runTcSWithEvBinds ev_binds_var thing_inside } + ; runTcSWithEvBinds ev_binds_var True thing_inside } + +-- | A variant of 'runTcS' that takes and returns an 'InertSet' for +-- later resumption of the 'TcS' session. Crucially, it doesn't +-- 'unflattenGivens' when done. +runTcSInerts :: InertSet -> TcS a -> TcM (a, InertSet) +runTcSInerts inerts tcs = do + ev_binds_var <- TcM.newTcEvBinds + -- Passing False here to prohibit unflattening + runTcSWithEvBinds ev_binds_var False $ do + setTcSInerts inerts + a <- tcs + new_inerts <- getTcSInerts + return (a, new_inerts) runTcSWithEvBinds :: EvBindsVar + -> Bool -- ^ Unflatten types afterwards? Don't if you want to reuse the InertSet. -> TcS a -> TcM a -runTcSWithEvBinds ev_binds_var tcs +runTcSWithEvBinds ev_binds_var unflatten tcs = do { unified_var <- TcM.newTcRef 0 ; step_count <- TcM.newTcRef 0 ; inert_var <- TcM.newTcRef emptyInert @@ -2824,7 +2837,7 @@ runTcSWithEvBinds ev_binds_var tcs ; when (count > 0) $ csTraceTcM $ return (text "Constraint solver steps =" <+> int count) - ; unflattenGivens inert_var + ; when unflatten $ unflattenGivens inert_var #if defined(DEBUG) ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var ===================================== testsuite/tests/pmcheck/should_compile/T17836.hs ===================================== @@ -0,0 +1,97 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE PatternSynonyms #-} +module PM where + +import Data.Type.Equality ( type (:~:)(..) ) +import qualified Data.Kind + +data Type :: Data.Kind.Type -> Data.Kind.Type where + SRecNil :: Type () + SRecCons :: String -> Type a -> Type b -> Type (a, b) + SIntTy :: Type Int + +pattern RecCons1 a <- (SRecCons _ _ a) + +eqType :: Type ty1 -> Type ty2 -> Maybe (ty1 :~: ty2) +eqType SRecNil SRecNil = Just Refl +eqType (SRecCons l1 s1 t1) (SRecCons l2 s2 t2) + | Just Refl <- s1 `eqType` s2 + , Just Refl <- t1 `eqType` t2 + , l1 == l2 + = Just Refl +eqType SIntTy SIntTy = Just Refl +eqType _ _ = Nothing + +massive :: Int -> Type ty -> Type recty -> (forall ty'. Type ty' -> m r) -> m r +massive fieldN sFieldTy sRecTy k = + case (fieldN, sFieldTy, sRecTy) of + (0, t, SRecCons _ t' _) + | Just Refl <- t `eqType` t' -> k sFieldTy + (1, t, RecCons1 (SRecCons _ t' _)) + | Just Refl <- t `eqType` t' -> k sFieldTy + (2, t, RecCons1 (RecCons1 (SRecCons _ t' _))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (3, t, RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (4, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (5, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (6, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (7, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (8, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (9, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (10, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (11, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (12, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (13, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (14, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (15, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (16, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (17, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (18, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (19, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (20, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (21, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (22, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (23, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (24, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (25, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (26, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (27, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (28, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (29, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (30, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (31, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (32, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + _ -> error "TODO support records >32" ===================================== testsuite/tests/pmcheck/should_compile/T17836b.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +module PM where + +data T a where + T :: T b -> T (a, b) + +pattern P a <- (T a) + +massive :: T recty -> () +massive (P (P (P (P (P (P (P (P (P (P (P (P (P (P (P (P (P _))))))))))))))))) = () ===================================== testsuite/tests/pmcheck/should_compile/T17836b.stderr ===================================== @@ -0,0 +1,10 @@ + +T17836b.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘massive’: + Patterns not matched: + T _ + P (T _) + P (P (T _)) + P (P (P (T _))) + ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -124,6 +124,12 @@ test('T17729', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17783', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17836', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17836b', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17977b', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17977', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17977b', collect_compiler_stats('bytes allocated',10), compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9da539b9e65511ffab50645f044ae2dced0ae128 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9da539b9e65511ffab50645f044ae2dced0ae128 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 14:46:08 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 07 Sep 2020 10:46:08 -0400 Subject: [Git][ghc/ghc][wip/T18645] Make `tcCheckSatisfiability` incremental (#18645) Message-ID: <5f5647b0951_80b3f8468fcad9c108746f7@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 at Glasgow Haskell Compiler / GHC Commits: 9d682f7d by Sebastian Graf at 2020-09-07T16:45:59+02:00 Make `tcCheckSatisfiability` incremental (#18645) By taking and returning an `InertSet`. Every new `TcS` session can then pick up where a prior session left with `setTcSInerts`. Since we don't want to unflatten the Givens (and because it leads to infinite loops, see !3971), we introduced a new variant of `runTcS`, `runTcSInerts`, that takes and returns the `InertSet` and makes sure not to unflatten the Givens after running the `TcS` action. Fixes #18645 and #17836. Metric Decrease: T17977b - - - - - 8 changed files: - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Monad.hs - + testsuite/tests/pmcheck/should_compile/T17836.hs - + testsuite/tests/pmcheck/should_compile/T17836b.hs - + testsuite/tests/pmcheck/should_compile/T17836b.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -523,13 +523,11 @@ nameTyCt pred_ty = do tyOracle :: TyState -> Bag PredType -> DsM (Maybe TyState) tyOracle (TySt inert) cts = do { evs <- traverse nameTyCt cts - ; let new_inert = inert `unionBags` evs ; tracePm "tyOracle" (ppr cts) - ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability new_inert + ; ((_warns, errs), res) <- initTcDsForSolver $ tcCheckSatisfiability inert evs ; case res of - Just True -> return (Just (TySt new_inert)) - Just False -> return Nothing - Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } + Just mb_new_inert -> return (TySt <$> mb_new_inert) + Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -47,7 +47,6 @@ import GHC.Prelude import GHC.Utils.Misc import GHC.Data.Bag import GHC.Data.FastString -import GHC.Types.Var (EvVar) import GHC.Types.Id import GHC.Types.Var.Env import GHC.Types.Unique.DSet @@ -68,7 +67,7 @@ import GHC.Core.Utils (exprType) import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim -import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Tc.Solver.Monad (InertSet, emptyInert) import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) @@ -596,15 +595,14 @@ initTmState = TmSt emptySDIE emptyCoreMap -- | The type oracle state. A poor man's 'GHC.Tc.Solver.Monad.InsertSet': The invariant is -- that all constraints in there are mutually compatible. -newtype TyState = TySt (Bag EvVar) +newtype TyState = TySt InertSet -- | Not user-facing. instance Outputable TyState where - ppr (TySt evs) - = braces $ hcat $ punctuate comma $ map (ppr . evVarPred) $ bagToList evs + ppr (TySt inert) = ppr inert initTyState :: TyState -initTyState = TySt emptyBag +initTyState = TySt emptyInert -- | A normalised refinement type ∇ (\"nabla\"), comprised of an inert set of -- canonical (i.e. mutually compatible) term and type constraints that form the ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -718,22 +718,22 @@ simplifyDefault theta ; return () } ------------------ -tcCheckSatisfiability :: Bag EvVar -> TcM Bool --- Return True if satisfiable, False if definitely contradictory -tcCheckSatisfiability given_ids - = do { lcl_env <- TcM.getLclEnv - ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env - ; (res, _ev_binds) <- runTcS $ - do { traceTcS "checkSatisfiability {" (ppr given_ids) - ; let given_cts = mkGivens given_loc (bagToList given_ids) - -- See Note [Superclasses and satisfiability] - ; solveSimpleGivens given_cts - ; insols <- getInertInsols - ; insols <- try_harder insols - ; traceTcS "checkSatisfiability }" (ppr insols) - ; return (isEmptyBag insols) } - ; return res } - where +tcCheckSatisfiability :: InertSet -> Bag EvVar -> TcM (Maybe InertSet) +-- Return (Just new_inerts) if satisfiable, Nothing if definitely contradictory +tcCheckSatisfiability inerts given_ids = do + (sat, new_inerts) <- runTcSInerts inerts $ do + traceTcS "checkSatisfiability {" (ppr inerts <+> ppr given_ids) + lcl_env <- TcS.getLclEnv + let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env + let given_cts = mkGivens given_loc (bagToList given_ids) + -- See Note [Superclasses and satisfiability] + solveSimpleGivens given_cts + insols <- getInertInsols + insols <- try_harder insols + traceTcS "checkSatisfiability }" (ppr insols) + return (isEmptyBag insols) + return $ if sat then Just new_inerts else Nothing + where try_harder :: Cts -> TcS Cts -- Maybe we have to search up the superclass chain to find -- an unsatisfiable constraint. Example: pmcheck/T3927b. @@ -749,15 +749,11 @@ tcCheckSatisfiability given_ids -- | Normalise a type as much as possible using the given constraints. -- See @Note [tcNormalise]@. -tcNormalise :: Bag EvVar -> Type -> TcM Type -tcNormalise given_ids ty - = do { lcl_env <- TcM.getLclEnv - ; let given_loc = mkGivenLoc topTcLevel UnkSkol lcl_env - ; norm_loc <- getCtLocM PatCheckOrigin Nothing - ; (res, _ev_binds) <- runTcS $ - do { traceTcS "tcNormalise {" (ppr given_ids) - ; let given_cts = mkGivens given_loc (bagToList given_ids) - ; solveSimpleGivens given_cts +tcNormalise :: InertSet -> Type -> TcM Type +tcNormalise inerts ty + = do { norm_loc <- getCtLocM PatCheckOrigin Nothing + ; (res, _new_inerts) <- runTcSInerts inerts $ + do { traceTcS "tcNormalise {" (ppr inerts) ; ty' <- flattenType norm_loc ty ; traceTcS "tcNormalise }" (ppr ty') ; pure ty' } @@ -788,8 +784,9 @@ Note [tcNormalise] tcNormalise is a rather atypical entrypoint to the constraint solver. Whereas most invocations of the constraint solver are intended to simplify a set of constraints or to decide if a particular set of constraints is satisfiable, -the purpose of tcNormalise is to take a type, plus some local constraints, and -normalise the type as much as possible with respect to those constraints. +the purpose of tcNormalise is to take a type, plus some locally solved +constraints in the form of an InertSet, and normalise the type as much as +possible with respect to those constraints. It does *not* reduce type or data family applications or look through newtypes. @@ -798,9 +795,9 @@ expression, it's possible that the type of the scrutinee will only reduce if some local equalities are solved for. See "Wrinkle: Local equalities" in Note [Type normalisation] in "GHC.HsToCore.PmCheck". -To accomplish its stated goal, tcNormalise first feeds the local constraints -into solveSimpleGivens, then uses flattenType to simplify the desired type -with respect to the givens. +To accomplish its stated goal, tcNormalise first initialises the solver monad +with the given InertCans, then uses flattenType to simplify the desired type +with respect to the Givens in the InertCans. *********************************************************************************** * * @@ -893,7 +890,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds ; psig_theta_vars <- mapM TcM.newEvVar psig_theta ; wanted_transformed_incl_derivs <- setTcLevel rhs_tclvl $ - runTcSWithEvBinds ev_binds_var $ + runTcSWithEvBinds ev_binds_var True $ do { let loc = mkGivenLoc rhs_tclvl UnkSkol $ env_lcl tc_env psig_givens = mkGivens loc psig_theta_vars ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -15,7 +15,7 @@ module GHC.Tc.Solver.Monad ( getWorkList, updWorkListTcS, pushLevelNoWorkList, -- The TcS monad - TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, + TcS, runTcS, runTcSDeriveds, runTcSWithEvBinds, runTcSInerts, failTcS, warnTcS, addErrTcS, runTcSEqualities, nestTcS, nestImplicTcS, setEvBindsTcS, @@ -55,7 +55,7 @@ module GHC.Tc.Solver.Monad ( tcLookupClass, tcLookupId, -- Inerts - InertSet(..), InertCans(..), + InertSet(..), InertCans(..), emptyInert, updInertTcS, updInertCans, updInertDicts, updInertIrreds, getNoGivenEqs, setInertCans, getInertEqs, getInertCans, getInertGivens, @@ -2785,28 +2785,41 @@ runTcS :: TcS a -- What to run -> TcM (a, EvBindMap) runTcS tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; res <- runTcSWithEvBinds ev_binds_var tcs + ; res <- runTcSWithEvBinds ev_binds_var True tcs ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var ; return (res, ev_binds) } - -- | This variant of 'runTcS' will keep solving, even when only Deriveds -- are left around. It also doesn't return any evidence, as callers won't -- need it. runTcSDeriveds :: TcS a -> TcM a runTcSDeriveds tcs = do { ev_binds_var <- TcM.newTcEvBinds - ; runTcSWithEvBinds ev_binds_var tcs } + ; runTcSWithEvBinds ev_binds_var True tcs } -- | This can deal only with equality constraints. runTcSEqualities :: TcS a -> TcM a runTcSEqualities thing_inside = do { ev_binds_var <- TcM.newNoTcEvBinds - ; runTcSWithEvBinds ev_binds_var thing_inside } + ; runTcSWithEvBinds ev_binds_var True thing_inside } + +-- | A variant of 'runTcS' that takes and returns an 'InertSet' for +-- later resumption of the 'TcS' session. Crucially, it doesn't +-- 'unflattenGivens' when done. +runTcSInerts :: InertSet -> TcS a -> TcM (a, InertSet) +runTcSInerts inerts tcs = do + ev_binds_var <- TcM.newTcEvBinds + -- Passing False here to prohibit unflattening + runTcSWithEvBinds ev_binds_var False $ do + setTcSInerts inerts + a <- tcs + new_inerts <- getTcSInerts + return (a, new_inerts) runTcSWithEvBinds :: EvBindsVar + -> Bool -- ^ Unflatten types afterwards? Don't if you want to reuse the InertSet. -> TcS a -> TcM a -runTcSWithEvBinds ev_binds_var tcs +runTcSWithEvBinds ev_binds_var unflatten tcs = do { unified_var <- TcM.newTcRef 0 ; step_count <- TcM.newTcRef 0 ; inert_var <- TcM.newTcRef emptyInert @@ -2824,7 +2837,7 @@ runTcSWithEvBinds ev_binds_var tcs ; when (count > 0) $ csTraceTcM $ return (text "Constraint solver steps =" <+> int count) - ; unflattenGivens inert_var + ; when unflatten $ unflattenGivens inert_var #if defined(DEBUG) ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var ===================================== testsuite/tests/pmcheck/should_compile/T17836.hs ===================================== @@ -0,0 +1,97 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE PatternSynonyms #-} +module PM where + +import Data.Type.Equality ( type (:~:)(..) ) +import qualified Data.Kind + +data Type :: Data.Kind.Type -> Data.Kind.Type where + SRecNil :: Type () + SRecCons :: String -> Type a -> Type b -> Type (a, b) + SIntTy :: Type Int + +pattern RecCons1 a <- (SRecCons _ _ a) + +eqType :: Type ty1 -> Type ty2 -> Maybe (ty1 :~: ty2) +eqType SRecNil SRecNil = Just Refl +eqType (SRecCons l1 s1 t1) (SRecCons l2 s2 t2) + | Just Refl <- s1 `eqType` s2 + , Just Refl <- t1 `eqType` t2 + , l1 == l2 + = Just Refl +eqType SIntTy SIntTy = Just Refl +eqType _ _ = Nothing + +massive :: Int -> Type ty -> Type recty -> (forall ty'. Type ty' -> m r) -> m r +massive fieldN sFieldTy sRecTy k = + case (fieldN, sFieldTy, sRecTy) of + (0, t, SRecCons _ t' _) + | Just Refl <- t `eqType` t' -> k sFieldTy + (1, t, RecCons1 (SRecCons _ t' _)) + | Just Refl <- t `eqType` t' -> k sFieldTy + (2, t, RecCons1 (RecCons1 (SRecCons _ t' _))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (3, t, RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (4, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (5, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (6, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (7, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (8, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (9, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (10, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (11, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (12, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (13, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (14, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (15, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (16, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (17, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (18, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (19, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (20, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (21, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (22, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (23, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (24, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (25, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (26, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (27, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (28, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (29, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (30, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (31, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _)))))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + (32, t, RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (RecCons1 (SRecCons _ t' _))))))))))))))))))))))))))))))))) + | Just Refl <- t `eqType` t' -> k sFieldTy + _ -> error "TODO support records >32" ===================================== testsuite/tests/pmcheck/should_compile/T17836b.hs ===================================== @@ -0,0 +1,11 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +module PM where + +data T a where + T :: T b -> T (a, b) + +pattern P a <- (T a) + +massive :: T recty -> () +massive (P (P (P (P (P (P (P (P (P (P (P (P (P (P (P (P (P _))))))))))))))))) = () ===================================== testsuite/tests/pmcheck/should_compile/T17836b.stderr ===================================== @@ -0,0 +1,10 @@ + +T17836b.hs:11:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘massive’: + Patterns not matched: + T _ + P (T _) + P (P (T _)) + P (P (P (T _))) + ... ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -124,6 +124,10 @@ test('T17729', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17783', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17836', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17836b', collect_compiler_stats('bytes allocated',10), compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17977', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17977b', collect_compiler_stats('bytes allocated',10), compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d682f7d6f0b022386fbc9ee57f4c90727d2fb7a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9d682f7d6f0b022386fbc9ee57f4c90727d2fb7a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 15:16:43 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 07 Sep 2020 11:16:43 -0400 Subject: [Git][ghc/ghc][wip/T18645] Extract definition of DsM into GHC.HsToCore.Types Message-ID: <5f564edb67b98_80b78f7ae410882414@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 at Glasgow Haskell Compiler / GHC Commits: abc22a63 by Sebastian Graf at 2020-09-07T17:08:27+02:00 Extract definition of DsM into GHC.HsToCore.Types `DsM` was previously defined in `GHC.Tc.Types`, along with `TcM`. But `GHC.Tc.Types` is in the set of transitive dependencies of `GHC.Parser`, a set which we aim to minimise. Test case `CheckParserDeps` checks for that. Having `DsM` in that set means the parser also depends on the innards of the pattern-match checker in `GHC.HsToCore.PmCheck.Types`, which is the reason we have that module in the first place. Recently, we represented the `TyState` by an `InertSet`, but that pulls the constraint solver as well as 250 more modules into the set of dependencies, triggering failure of `CheckParserDeps`. Clearly, we want to evolve the pattern-match checker (and the desugarer) without being concerned by this test, so this patch includes a small refactor that puts `DsM` into its own module. - - - - - 8 changed files: - compiler/GHC/Driver/Hooks.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - + compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Hs.Binds import GHC.Hs.Expr import GHC.Data.OrdList import GHC.Tc.Types +import GHC.HsToCore.Types import GHC.Data.Bag import GHC.Types.Name.Reader import GHC.Types.Name ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -816,7 +816,7 @@ ds_prag_expr (HsPragSCC _ _ cc) expr = do mod_name <- getModule count <- goptM Opt_ProfCountEntries let nm = sl_fs cc - flavour <- ExprCC <$> getCCIndexM nm + flavour <- ExprCC <$> getCCIndexDsM nm Tick (ProfNote (mkUserCC nm mod_name (getLoc expr) flavour) count True) <$> dsLExpr expr else dsLExpr expr ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -30,6 +30,7 @@ module GHC.HsToCore.Monad ( getGhcModeDs, dsGetFamInstEnvs, dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon, dsLookupDataCon, dsLookupConLike, + getCCIndexDsM, DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv, @@ -73,6 +74,7 @@ import GHC.Types.Basic ( Origin ) import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Core.TyCon +import GHC.HsToCore.Types import GHC.HsToCore.PmCheck.Types import GHC.Types.Id import GHC.Unit.Module @@ -614,3 +616,7 @@ pprRuntimeTrace str doc expr = do message = App (Var unpackCStringId) $ Lit $ mkLitString $ showSDoc dflags (hang (text str) 4 doc) return $ mkApps (Var traceId) [Type (exprType expr), message, expr] + +-- | See 'getCCIndexM'. +getCCIndexDsM :: FastString -> DsM CostCentreIndex +getCCIndexDsM = getCCIndexM ds_cc_st ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -0,0 +1,77 @@ +-- | Various types used during desugaring. +module GHC.HsToCore.Types ( + DsM, DsLclEnv(..), DsGblEnv(..), + DsMetaEnv, DsMetaVal(..), CompleteMatches + ) where + +import Data.IORef + +import GHC.Types.CostCentre.State +import GHC.Types.Name.Env +import GHC.Types.SrcLoc +import GHC.Types.Var +import GHC.Hs (HsExpr, GhcTc) +import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) +import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.Core.FamInstEnv +import GHC.Utils.Error +import GHC.Utils.Outputable as Outputable +import GHC.Unit.Module + +{- +************************************************************************ +* * + Desugarer monad +* * +************************************************************************ + +Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around +a @UniqueSupply@ and some annotations, which +presumably include source-file location information: +-} + +-- | Global read-only context and state of the desugarer. +-- The statefulness is implemented through 'IORef's. +data DsGblEnv + = DsGblEnv + { ds_mod :: Module -- For SCC profiling + , ds_fam_inst_env :: FamInstEnv -- Like tcg_fam_inst_env + , ds_unqual :: PrintUnqualified + , ds_msgs :: IORef Messages -- Warning messages + , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, + -- possibly-imported things + , ds_complete_matches :: CompleteMatches + -- Additional complete pattern matches + , ds_cc_st :: IORef CostCentreState + -- Tracking indices for cost centre annotations + } + +instance ContainsModule DsGblEnv where + extractModule = ds_mod + +-- | Local state of the desugarer, extended as we lexically descend +data DsLclEnv + = DsLclEnv + { dsl_meta :: DsMetaEnv -- ^ Template Haskell bindings + , dsl_loc :: RealSrcSpan -- ^ To put in pattern-matching error msgs + , dsl_nablas :: Nablas + -- ^ See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck". + -- The set of reaching values Nablas is augmented as we walk inwards, refined + -- through each pattern match in turn + } + +-- Inside [| |] brackets, the desugarer looks +-- up variables in the DsMetaEnv +type DsMetaEnv = NameEnv DsMetaVal + +data DsMetaVal + = DsBound Id -- Bound by a pattern inside the [| |]. + -- Will be dynamically alpha renamed. + -- The Id has type THSyntax.Var + + | DsSplice (HsExpr GhcTc) -- These bindings are introduced by + -- the PendingSplices on a HsBracketOut + +-- | Desugaring monad. See also 'TcM'. +type DsM = TcRnIf DsGblEnv DsLclEnv + ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -681,7 +681,7 @@ funBindTicks loc fun_id mod sigs = getOccFS (Var.varName fun_id) cc_name = moduleNameFS (moduleName mod) `appendFS` consFS '.' cc_str = do - flavour <- DeclCC <$> getCCIndexM cc_name + flavour <- DeclCC <$> getCCIndexTcM cc_name let cc = mkUserCC cc_name mod loc flavour return [ProfNote cc True True] | otherwise ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -45,11 +45,7 @@ module GHC.Tc.Types( IdBindingInfo(..), ClosedTypeId, RhsNames, IsGroupClosed(..), SelfBootInfo(..), - pprTcTyThingCategory, pprPECategory, CompleteMatch, - - -- Desugaring types - DsM, DsLclEnv(..), DsGblEnv(..), - DsMetaEnv, DsMetaVal(..), CompleteMatches, + pprTcTyThingCategory, pprPECategory, CompleteMatch, CompleteMatches, -- Template Haskell ThStage(..), SpliceType(..), PendingStuff(..), @@ -190,7 +186,6 @@ type TcRn = TcRnIf TcGblEnv TcLclEnv -- Type inference type IfM lcl = TcRnIf IfGblEnv lcl -- Iface stuff type IfG = IfM () -- Top level type IfL = IfM IfLclEnv -- Nested -type DsM = TcRnIf DsGblEnv DsLclEnv -- Desugaring -- TcRn is the type-checking and renaming monad: the main monad that -- most type-checking takes place in. The global environment is @@ -289,58 +284,6 @@ data IfLclEnv if_id_env :: FastStringEnv Id -- Nested id binding } -{- -************************************************************************ -* * - Desugarer monad -* * -************************************************************************ - -Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around -a @UniqueSupply@ and some annotations, which -presumably include source-file location information: --} - -data DsGblEnv - = DsGblEnv - { ds_mod :: Module -- For SCC profiling - , ds_fam_inst_env :: FamInstEnv -- Like tcg_fam_inst_env - , ds_unqual :: PrintUnqualified - , ds_msgs :: IORef Messages -- Warning messages - , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, - -- possibly-imported things - , ds_complete_matches :: CompleteMatches - -- Additional complete pattern matches - , ds_cc_st :: IORef CostCentreState - -- Tracking indices for cost centre annotations - } - -instance ContainsModule DsGblEnv where - extractModule = ds_mod - -data DsLclEnv = DsLclEnv { - dsl_meta :: DsMetaEnv, -- Template Haskell bindings - dsl_loc :: RealSrcSpan, -- To put in pattern-matching error msgs - - -- See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck" - -- The set of reaching values Nablas is augmented as we walk inwards, - -- refined through each pattern match in turn - dsl_nablas :: Nablas - } - --- Inside [| |] brackets, the desugarer looks --- up variables in the DsMetaEnv -type DsMetaEnv = NameEnv DsMetaVal - -data DsMetaVal - = DsBound Id -- Bound by a pattern inside the [| |]. - -- Will be dynamically alpha renamed. - -- The Id has type THSyntax.Var - - | DsSplice (HsExpr GhcTc) -- These bindings are introduced by - -- the PendingSplices on a HsBracketOut - - {- ************************************************************************ * * ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -138,7 +138,7 @@ module GHC.Tc.Utils.Monad( withException, -- * Stuff for cost centres. - ContainsCostCentreState(..), getCCIndexM, + getCCIndexM, getCCIndexTcM, -- * Types etc. module GHC.Tc.Types, @@ -2081,23 +2081,16 @@ discussion). We don't currently know a general solution to this problem, but we can use uninterruptibleMask_ to avoid the situation. -} --- | Environments which track 'CostCentreState' -class ContainsCostCentreState e where - extractCostCentreState :: e -> TcRef CostCentreState - -instance ContainsCostCentreState TcGblEnv where - extractCostCentreState = tcg_cc_st - -instance ContainsCostCentreState DsGblEnv where - extractCostCentreState = ds_cc_st - -- | Get the next cost centre index associated with a given name. -getCCIndexM :: (ContainsCostCentreState gbl) - => FastString -> TcRnIf gbl lcl CostCentreIndex -getCCIndexM nm = do +getCCIndexM :: (gbl -> TcRef CostCentreState) -> FastString -> TcRnIf gbl lcl CostCentreIndex +getCCIndexM get_ccs nm = do env <- getGblEnv - let cc_st_ref = extractCostCentreState env + let cc_st_ref = get_ccs env cc_st <- readTcRef cc_st_ref let (idx, cc_st') = getCCIndex nm cc_st writeTcRef cc_st_ref cc_st' return idx + +-- | See 'getCCIndexM'. +getCCIndexTcM :: FastString -> TcM CostCentreIndex +getCCIndexTcM = getCCIndexM tcg_cc_st ===================================== compiler/ghc.cabal.in ===================================== @@ -312,6 +312,7 @@ Library GHC.HsToCore.PmCheck GHC.HsToCore.Coverage GHC.HsToCore + GHC.HsToCore.Types GHC.HsToCore.Arrows GHC.HsToCore.Binds GHC.HsToCore.Foreign.Call View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/abc22a63877f024c72d23c943a689e242ef13945 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/abc22a63877f024c72d23c943a689e242ef13945 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 15:36:11 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Mon, 07 Sep 2020 11:36:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18660 Message-ID: <5f56536bb4c4b_80b107045bc108901f9@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T18660 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18660 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 16:02:28 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Mon, 07 Sep 2020 12:02:28 -0400 Subject: [Git][ghc/ghc][wip/T18645] Extract definition of DsM into GHC.HsToCore.Types Message-ID: <5f56599490306_80b3f8495846378109011df@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 at Glasgow Haskell Compiler / GHC Commits: e8f5cf01 by Sebastian Graf at 2020-09-07T18:02:20+02:00 Extract definition of DsM into GHC.HsToCore.Types `DsM` was previously defined in `GHC.Tc.Types`, along with `TcM`. But `GHC.Tc.Types` is in the set of transitive dependencies of `GHC.Parser`, a set which we aim to minimise. Test case `CheckParserDeps` checks for that. Having `DsM` in that set means the parser also depends on the innards of the pattern-match checker in `GHC.HsToCore.PmCheck.Types`, which is the reason we have that module in the first place. Recently, we represented the `TyState` by an `InertSet`, but that pulls the constraint solver as well as 250 more modules into the set of dependencies, triggering failure of `CheckParserDeps`. Clearly, we want to evolve the pattern-match checker (and the desugarer) without being concerned by this test, so this patch includes a small refactor that puts `DsM` into its own module. - - - - - 8 changed files: - compiler/GHC/Driver/Hooks.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Monad.hs - + compiler/GHC/HsToCore/Types.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/ghc.cabal.in Changes: ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -38,6 +38,7 @@ import GHC.Hs.Binds import GHC.Hs.Expr import GHC.Data.OrdList import GHC.Tc.Types +import GHC.HsToCore.Types import GHC.Data.Bag import GHC.Types.Name.Reader import GHC.Types.Name ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -816,7 +816,7 @@ ds_prag_expr (HsPragSCC _ _ cc) expr = do mod_name <- getModule count <- goptM Opt_ProfCountEntries let nm = sl_fs cc - flavour <- ExprCC <$> getCCIndexM nm + flavour <- ExprCC <$> getCCIndexDsM nm Tick (ProfNote (mkUserCC nm mod_name (getLoc expr) flavour) count True) <$> dsLExpr expr else dsLExpr expr ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -30,6 +30,7 @@ module GHC.HsToCore.Monad ( getGhcModeDs, dsGetFamInstEnvs, dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon, dsLookupDataCon, dsLookupConLike, + getCCIndexDsM, DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv, @@ -73,6 +74,7 @@ import GHC.Types.Basic ( Origin ) import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Core.TyCon +import GHC.HsToCore.Types import GHC.HsToCore.PmCheck.Types import GHC.Types.Id import GHC.Unit.Module @@ -614,3 +616,7 @@ pprRuntimeTrace str doc expr = do message = App (Var unpackCStringId) $ Lit $ mkLitString $ showSDoc dflags (hang (text str) 4 doc) return $ mkApps (Var traceId) [Type (exprType expr), message, expr] + +-- | See 'getCCIndexM'. +getCCIndexDsM :: FastString -> DsM CostCentreIndex +getCCIndexDsM = getCCIndexM ds_cc_st ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -0,0 +1,77 @@ +-- | Various types used during desugaring. +module GHC.HsToCore.Types ( + DsM, DsLclEnv(..), DsGblEnv(..), + DsMetaEnv, DsMetaVal(..), CompleteMatches + ) where + +import Data.IORef + +import GHC.Types.CostCentre.State +import GHC.Types.Name.Env +import GHC.Types.SrcLoc +import GHC.Types.Var +import GHC.Hs (HsExpr, GhcTc) +import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) +import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.Core.FamInstEnv +import GHC.Utils.Error +import GHC.Utils.Outputable as Outputable +import GHC.Unit.Module + +{- +************************************************************************ +* * + Desugarer monad +* * +************************************************************************ + +Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around +a @UniqueSupply@ and some annotations, which +presumably include source-file location information: +-} + +-- | Global read-only context and state of the desugarer. +-- The statefulness is implemented through 'IORef's. +data DsGblEnv + = DsGblEnv + { ds_mod :: Module -- For SCC profiling + , ds_fam_inst_env :: FamInstEnv -- Like tcg_fam_inst_env + , ds_unqual :: PrintUnqualified + , ds_msgs :: IORef Messages -- Warning messages + , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, + -- possibly-imported things + , ds_complete_matches :: CompleteMatches + -- Additional complete pattern matches + , ds_cc_st :: IORef CostCentreState + -- Tracking indices for cost centre annotations + } + +instance ContainsModule DsGblEnv where + extractModule = ds_mod + +-- | Local state of the desugarer, extended as we lexically descend +data DsLclEnv + = DsLclEnv + { dsl_meta :: DsMetaEnv -- ^ Template Haskell bindings + , dsl_loc :: RealSrcSpan -- ^ To put in pattern-matching error msgs + , dsl_nablas :: Nablas + -- ^ See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck". + -- The set of reaching values Nablas is augmented as we walk inwards, refined + -- through each pattern match in turn + } + +-- Inside [| |] brackets, the desugarer looks +-- up variables in the DsMetaEnv +type DsMetaEnv = NameEnv DsMetaVal + +data DsMetaVal + = DsBound Id -- Bound by a pattern inside the [| |]. + -- Will be dynamically alpha renamed. + -- The Id has type THSyntax.Var + + | DsSplice (HsExpr GhcTc) -- These bindings are introduced by + -- the PendingSplices on a HsBracketOut + +-- | Desugaring monad. See also 'TcM'. +type DsM = TcRnIf DsGblEnv DsLclEnv + ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -681,7 +681,7 @@ funBindTicks loc fun_id mod sigs = getOccFS (Var.varName fun_id) cc_name = moduleNameFS (moduleName mod) `appendFS` consFS '.' cc_str = do - flavour <- DeclCC <$> getCCIndexM cc_name + flavour <- DeclCC <$> getCCIndexTcM cc_name let cc = mkUserCC cc_name mod loc flavour return [ProfNote cc True True] | otherwise ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -45,11 +45,7 @@ module GHC.Tc.Types( IdBindingInfo(..), ClosedTypeId, RhsNames, IsGroupClosed(..), SelfBootInfo(..), - pprTcTyThingCategory, pprPECategory, CompleteMatch, - - -- Desugaring types - DsM, DsLclEnv(..), DsGblEnv(..), - DsMetaEnv, DsMetaVal(..), CompleteMatches, + pprTcTyThingCategory, pprPECategory, CompleteMatch, CompleteMatches, -- Template Haskell ThStage(..), SpliceType(..), PendingStuff(..), @@ -105,7 +101,6 @@ import GHC.Tc.Types.Origin import GHC.Types.Annotations import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Data.IOEnv import GHC.Types.Name.Reader import GHC.Types.Name @@ -190,7 +185,6 @@ type TcRn = TcRnIf TcGblEnv TcLclEnv -- Type inference type IfM lcl = TcRnIf IfGblEnv lcl -- Iface stuff type IfG = IfM () -- Top level type IfL = IfM IfLclEnv -- Nested -type DsM = TcRnIf DsGblEnv DsLclEnv -- Desugaring -- TcRn is the type-checking and renaming monad: the main monad that -- most type-checking takes place in. The global environment is @@ -289,58 +283,6 @@ data IfLclEnv if_id_env :: FastStringEnv Id -- Nested id binding } -{- -************************************************************************ -* * - Desugarer monad -* * -************************************************************************ - -Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around -a @UniqueSupply@ and some annotations, which -presumably include source-file location information: --} - -data DsGblEnv - = DsGblEnv - { ds_mod :: Module -- For SCC profiling - , ds_fam_inst_env :: FamInstEnv -- Like tcg_fam_inst_env - , ds_unqual :: PrintUnqualified - , ds_msgs :: IORef Messages -- Warning messages - , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, - -- possibly-imported things - , ds_complete_matches :: CompleteMatches - -- Additional complete pattern matches - , ds_cc_st :: IORef CostCentreState - -- Tracking indices for cost centre annotations - } - -instance ContainsModule DsGblEnv where - extractModule = ds_mod - -data DsLclEnv = DsLclEnv { - dsl_meta :: DsMetaEnv, -- Template Haskell bindings - dsl_loc :: RealSrcSpan, -- To put in pattern-matching error msgs - - -- See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck" - -- The set of reaching values Nablas is augmented as we walk inwards, - -- refined through each pattern match in turn - dsl_nablas :: Nablas - } - --- Inside [| |] brackets, the desugarer looks --- up variables in the DsMetaEnv -type DsMetaEnv = NameEnv DsMetaVal - -data DsMetaVal - = DsBound Id -- Bound by a pattern inside the [| |]. - -- Will be dynamically alpha renamed. - -- The Id has type THSyntax.Var - - | DsSplice (HsExpr GhcTc) -- These bindings are introduced by - -- the PendingSplices on a HsBracketOut - - {- ************************************************************************ * * ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -138,7 +138,7 @@ module GHC.Tc.Utils.Monad( withException, -- * Stuff for cost centres. - ContainsCostCentreState(..), getCCIndexM, + getCCIndexM, getCCIndexTcM, -- * Types etc. module GHC.Tc.Types, @@ -2081,23 +2081,16 @@ discussion). We don't currently know a general solution to this problem, but we can use uninterruptibleMask_ to avoid the situation. -} --- | Environments which track 'CostCentreState' -class ContainsCostCentreState e where - extractCostCentreState :: e -> TcRef CostCentreState - -instance ContainsCostCentreState TcGblEnv where - extractCostCentreState = tcg_cc_st - -instance ContainsCostCentreState DsGblEnv where - extractCostCentreState = ds_cc_st - -- | Get the next cost centre index associated with a given name. -getCCIndexM :: (ContainsCostCentreState gbl) - => FastString -> TcRnIf gbl lcl CostCentreIndex -getCCIndexM nm = do +getCCIndexM :: (gbl -> TcRef CostCentreState) -> FastString -> TcRnIf gbl lcl CostCentreIndex +getCCIndexM get_ccs nm = do env <- getGblEnv - let cc_st_ref = extractCostCentreState env + let cc_st_ref = get_ccs env cc_st <- readTcRef cc_st_ref let (idx, cc_st') = getCCIndex nm cc_st writeTcRef cc_st_ref cc_st' return idx + +-- | See 'getCCIndexM'. +getCCIndexTcM :: FastString -> TcM CostCentreIndex +getCCIndexTcM = getCCIndexM tcg_cc_st ===================================== compiler/ghc.cabal.in ===================================== @@ -312,6 +312,7 @@ Library GHC.HsToCore.PmCheck GHC.HsToCore.Coverage GHC.HsToCore + GHC.HsToCore.Types GHC.HsToCore.Arrows GHC.HsToCore.Binds GHC.HsToCore.Foreign.Call View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8f5cf01892647498afe53fe4311d06633c5bafd -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e8f5cf01892647498afe53fe4311d06633c5bafd You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 16:25:49 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 12:25:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/locale-fixes Message-ID: <5f565f0db97a6_80b3f840a9bfeec109075ed@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/locale-fixes at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/locale-fixes You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 16:48:37 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Mon, 07 Sep 2020 12:48:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18599-split-construct Message-ID: <5f566465ae5c8_80b3f848a39ac801090958f@gitlab.haskell.org.mail> Shayne Fletcher pushed new branch wip/T18599-split-construct at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18599-split-construct You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 18:18:51 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Mon, 07 Sep 2020 14:18:51 -0400 Subject: [Git][ghc/ghc][wip/T18599-split-construct] Generalize mkRdrRecordUpd Message-ID: <5f56798b837a6_80bae620d010919243@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599-split-construct at Glasgow Haskell Compiler / GHC Commits: 52dda663 by Shayne Fletcher at 2020-09-07T14:18:09-04:00 Generalize mkRdrRecordUpd - - - - - 2 changed files: - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/ThToHs.hs Changes: ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -2343,21 +2343,35 @@ mkRecConstrOrUpdate -> SrcSpan -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan) -> PV (HsExpr GhcPs) - mkRecConstrOrUpdate _ (L l (HsVar _ (L _ c))) _ (fs,dd) | isRdrDataCon c = return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd)) mkRecConstrOrUpdate dot exp _ (fs,dd) | Just dd_loc <- dd = addFatalError dd_loc (text "You cannot use `..' in a record update") - | otherwise = return (mkRdrRecordUpd dot exp (map (fmap mk_rec_upd_field) (map fbindToRecField fs))) - -mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs -mkRdrRecordUpd dot exp flds - -- If RecordDotSyntax is in effect produce a set_field expression. - | dot = unLoc $ foldl' mkSetField exp flds - | otherwise = RecordUpd { rupd_ext = noExtField - , rupd_expr = exp - , rupd_flds = flds } + | otherwise = return (mkRdrRecordUpd' dot exp fs) + +mkRdrRecordUpd' :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> HsExpr GhcPs +mkRdrRecordUpd' dot exp fbinds = + if not dot + then + mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) $ map fbindToRecField fbinds) + else + foldl' fieldUpdate (unLoc exp) fbinds + where + fieldUpdate :: HsExpr GhcPs -> Fbind (HsExpr GhcPs) -> HsExpr GhcPs + fieldUpdate acc f = + case f of + -- Remember to sort out issues with location info here. + Fbind field -> + let updField = fmap mk_rec_upd_field field + in unLoc $ foldl' mkSetField (noLoc acc) [updField] + Pbind fieldUpdater -> unLoc (fieldUpdater (noLoc acc)) + +mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs +mkRdrRecordUpd exp flds + = RecordUpd { rupd_ext = noExtField + , rupd_expr = exp + , rupd_flds = flds } mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs mkRdrRecordCon con flds @@ -2369,10 +2383,6 @@ mk_rec_fields :: [Fbind b] -> Maybe SrcSpan -> HsRecFields GhcPs (Located b) mk_rec_fields fs Nothing = HsRecFields { rec_flds = map fbindToRecField fs, rec_dotdot = Nothing } mk_rec_fields fs (Just s) = HsRecFields { rec_flds = map fbindToRecField fs , rec_dotdot = Just (L s (length fs)) } --- mk_rec_fields :: [Located (HsRecField (GhcPass p) arg)] -> Maybe SrcSpan -> HsRecFields (GhcPass p) arg --- mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing } --- mk_rec_fields fs (Just s) = HsRecFields { rec_flds = fs --- , rec_dotdot = Just (L s (length fs)) } mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun) ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -1009,7 +1009,7 @@ cvtl e = wrapL (cvt e) ; flds' <- mapM (cvtFld (mkAmbiguousFieldOcc . noLoc)) flds - ; return $ mkRdrRecordUpd False e' flds' } + ; return $ mkRdrRecordUpd e' flds' } cvt (StaticE e) = fmap (HsStatic noExtField) $ cvtl e cvt (UnboundVarE s) = do -- Use of 'vcName' here instead of 'vName' is -- important, because UnboundVarE may contain View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52dda6633419ee66e6062508519dd89224d6deb4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52dda6633419ee66e6062508519dd89224d6deb4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 18:38:24 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 07 Sep 2020 14:38:24 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: Add clarification regarding poll/kqueue flags Message-ID: <5f567e2096ac6_80b3f848bc0dd58109249fd@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 581a592c by Moritz Angermann at 2020-09-07T14:38:09-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - 80f3f4a6 by Sylvain Henry at 2020-09-07T14:38:13-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - 20 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/UpdateIdInfos.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - docs/users_guide/phases.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - libraries/base/configure.ac - mk/config.mk.in - testsuite/tests/rts/all.T Changes: ===================================== .gitlab-ci.yml ===================================== @@ -856,13 +856,16 @@ validate-x86_64-linux-fedora27: - ghc.tar.xz - junit.xml -validate-x86_64-windows-hadrian: +.build-x86_64-windows-hadrian: extends: .build-windows-hadrian variables: MSYSTEM: MINGW64 - TEST_ENV: "x86_64-windows-hadrian" + TEST_ENV: "x86_64-windows" cache: - key: "x86_64-windows-hadrian-$WINDOWS_TOOLCHAIN_VERSION" + key: "x86_64-windows-$WINDOWS_TOOLCHAIN_VERSION" + +validate-x86_64-windows-hadrian: + extends: .build-x86_64-windows-hadrian .build-windows-make: extends: .build-windows @@ -903,16 +906,17 @@ nightly-x86_64-windows: variables: BUILD_FLAVOUR: "validate" -# Normal Windows validate builds are profiled; that won't do for releases. +# Normal Windows validate builds lack profiled libraries; that won't do for +# releases. release-x86_64-windows: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BUILD_FLAVOUR: "perf" - # + release-x86_64-windows-integer-simple: <<: *release - extends: .build-x86_64-windows-make + extends: .build-x86_64-windows-hadrian variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" ===================================== .gitlab/ci.sh ===================================== @@ -427,10 +427,12 @@ function clean() { } function run_hadrian() { + if [ -z "$BIGNUM_BACKEND" ]; then BIGNUM_BACKEND="gmp"; fi run hadrian/build-cabal \ --flavour="$FLAVOUR" \ -j"$cores" \ --broken-test="$BROKEN_TESTS" \ + --bignum=$BIGNUM_BACKEND \ $HADRIAN_ARGS \ $@ } ===================================== aclocal.m4 ===================================== @@ -602,6 +602,18 @@ AC_DEFUN([FP_SETTINGS], else SettingsOptCommand="$OptCmd" fi + if test -z "$OtoolCmd" + then + SettingsOtoolCommand="otool" + else + SettingsOtoolCommand="$OtoolCmd" + fi + if test -z "$InstallNameToolCmd" + then + SettingsInstallNameToolCommand="install_name_tool" + else + SettingsInstallNameToolCommand="$InstallNameToolCmd" + fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -621,6 +633,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -394,7 +394,56 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commands. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc's ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1188,8 +1237,11 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do hscGenHardCode hsc_env' cgguts mod_location output_fn final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just cg_infos)) - let final_mod_details = {-# SCC updateModDetailsIdInfos #-} - updateModDetailsIdInfos iface_dflags cg_infos mod_details + let final_mod_details + | gopt Opt_OmitInterfacePragmas iface_dflags + = mod_details + | otherwise = {-# SCC updateModDetailsIdInfos #-} + updateModDetailsIdInfos cg_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] @@ -1787,9 +1839,12 @@ linkBinary' staticLink dflags o_files dep_units = do rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then GHC.SysTools.runLibtool - else GHC.SysTools.runLink + let link dflags args | staticLink = GHC.SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = GHC.SysTools.runLink dflags args >> GHC.SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = GHC.SysTools.runLink dflags args + link dflags ( map GHC.SysTools.Option verbFlags ++ [ GHC.SysTools.Option "-o" @@ -1856,7 +1911,13 @@ linkBinary' staticLink dflags o_files dep_units = do ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -145,8 +145,8 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, + pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool, + pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -885,6 +885,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags +pgm_otool :: DynFlags -> String +pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) @@ -2267,6 +2271,10 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } + , make_ord_flag defFlag "pgmotool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f} + , make_ord_flag defFlag "pgminstall_name_tool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f} , make_ord_flag defFlag "pgmranlib" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } @@ -3780,7 +3788,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -3791,6 +3798,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -3831,6 +3840,29 @@ default_PIC platform = -- information. _ -> [] + +-- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS +-- versions the number of load commands we can embed in a dynamic library is +-- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only +-- link the needed dylibs instead of linking the full dependency closure. +-- +-- If we split the library linking into injecting -rpath and -l @rpath/... +-- components, we will reduce the number of libraries we link, however we will +-- still inject one -rpath entry for each library, independent of their use. +-- That is, we even inject -rpath values for libraries that we dead_strip in +-- the end. As such we can run afoul of the load command size limit simply +-- by polluting the load commands with RPATH entries. +-- +-- Thus, we disable Opt_RPath by default on OSDarwin. The savvy user can always +-- enable it with -use-rpath if they so wish. +-- +-- See Note [Dynamic linking on macOS] + +default_RPath :: Platform -> [GeneralFlag] +default_RPath platform | platformOS platform == OSDarwin = [] +default_RPath _ = [Opt_RPath] + + -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] ===================================== compiler/GHC/Iface/UpdateIdInfos.hs ===================================== @@ -8,7 +8,6 @@ import GHC.Prelude import GHC.Core import GHC.Core.InstEnv -import GHC.Driver.Session import GHC.Driver.Types import GHC.StgToCmm.Types (CgInfos (..)) import GHC.Types.Id @@ -28,16 +27,11 @@ import GHC.Utils.Panic -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types. updateModDetailsIdInfos - :: DynFlags - -> CgInfos + :: CgInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsIdInfos dflags _ mod_details - | gopt Opt_OmitInterfacePragmas dflags - = mod_details - -updateModDetailsIdInfos _ cg_infos mod_details = +updateModDetailsIdInfos cg_infos mod_details = let ModDetails{ md_types = type_env -- for unfoldings , md_insts = insts ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -929,20 +929,22 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,6 +34,8 @@ module GHC.Settings , sPgm_windres , sPgm_libtool , sPgm_ar + , sPgm_otool + , sPgm_install_name_tool , sPgm_ranlib , sPgm_lo , sPgm_lc @@ -107,6 +109,8 @@ data ToolSettings = ToolSettings , toolSettings_pgm_windres :: String , toolSettings_pgm_libtool :: String , toolSettings_pgm_ar :: String + , toolSettings_pgm_otool :: String + , toolSettings_pgm_install_name_tool :: String , toolSettings_pgm_ranlib :: String , -- | LLVM: opt llvm optimiser toolSettings_pgm_lo :: (String, [Option]) @@ -216,6 +220,10 @@ sPgm_libtool :: Settings -> String sPgm_libtool = toolSettings_pgm_libtool . sToolSettings sPgm_ar :: Settings -> String sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_otool :: Settings -> String +sPgm_otool = toolSettings_pgm_otool . sToolSettings +sPgm_install_name_tool :: Settings -> String +sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings sPgm_ranlib :: Settings -> String sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings sPgm_lo :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -115,6 +115,8 @@ initSettings top_dir = do windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -191,6 +193,8 @@ initSettings top_dir = do , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) ===================================== compiler/GHC/SysTools.hs ===================================== @@ -261,7 +261,10 @@ linkDynLib dflags0 o_files dep_packages | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `Set.member` ways dflags + -- Only if we want dynamic libraries + WayDyn `Set.member` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -386,8 +389,15 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the leftover + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -28,6 +28,10 @@ import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pa import GHC.SysTools.Process import GHC.SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,41 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included in the load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of libraries end up being truely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath at . +-- +-- See Note [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + -- find any pre-existing LC_PATH items + info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib] + let paths = concatMap f info + where f ("path":p:_) = [p] + f _ = [] + lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ] + -- only find those rpaths, that aren't already in the library. + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths') + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -329,6 +368,17 @@ runAr dflags cwd args = traceToolCommand dflags "ar" $ do let ar = pgm_ar dflags runSomethingFiltered dflags id "Ar" ar args cwd Nothing +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing + runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do let ranlib = pgm_ranlib dflags ===================================== configure.ac ===================================== @@ -699,6 +699,18 @@ else fi AC_SUBST([LibtoolCmd]) +dnl ** Which otool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([OTOOL], [otool]) +OtoolCmd="$OTOOL" +AC_SUBST(OtoolCmd) + +dnl ** Which install_name_tool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool]) +InstallNameToolCmd="$INSTALL_NAME_TOOL" +AC_SUBST(InstallNameToolCmd) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -1522,6 +1534,8 @@ echo "\ libtool : $LibtoolCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd + otool : $OtoolCmd + install_name_tool : $InstallNameToolCmd windres : $WindresCmd dllwrap : $DllWrapCmd genlib : $GenlibCmd ===================================== docs/users_guide/phases.rst ===================================== @@ -95,6 +95,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only). +.. ghc-flag:: -pgmotool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inspect mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and + executables to read the dynamic library dependencies. We will compute + the necessary ``runpath``s to embed for the dependencies based on the + result of the ``otool`` call. + +.. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inject ``runpath`` into mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inject ``runpath``s into mach-o dynamic + libraries and executables. As detected by the ``otool`` call. + .. ghc-flag:: -pgmwindres ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the program for embedding manifests on Windows. :type: dynamic ===================================== hadrian/cfg/system.config.in ===================================== @@ -152,6 +152,8 @@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ +settings-otool-command = @SettingsOtoolCommand@ +settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-libtool-command = @SettingsLibtoolCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -114,6 +114,8 @@ data SettingsFileSetting | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_OtoolCommand + | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_LibtoolCommand @@ -200,6 +202,8 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_OtoolCommand -> "settings-otool-command" + SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -308,6 +308,8 @@ generateSettings = do , ("ar flags", expr $ lookupValueOrError configFile "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) ===================================== includes/ghc.mk ===================================== @@ -233,6 +233,8 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ + @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ ===================================== libraries/base/configure.ac ===================================== @@ -47,9 +47,13 @@ AC_CHECK_FUNCS([clock_gettime]) AC_CHECK_FUNCS([getclock getrusage times]) AC_CHECK_FUNCS([_chsize ftruncate]) -AC_CHECK_FUNCS([epoll_ctl eventfd kevent kevent64 kqueue poll]) - # event-related fun +# The line below already defines HAVE_KQUEUE and HAVE_POLL, so technically some of the +# subsequent portions that redefine them could be skipped. However, we keep those portions +# to keep kqueue/poll in line with HAVE_EPOLL and possible other additions in the future. You +# should be aware of this peculiarity if you try to simulate not having kqueue or poll by +# moving away header files (see also https://gitlab.haskell.org/ghc/ghc/-/issues/9283) +AC_CHECK_FUNCS([epoll_ctl eventfd kevent kevent64 kqueue poll]) if test "$ac_cv_header_sys_epoll_h" = yes && test "$ac_cv_func_epoll_ctl" = yes; then AC_DEFINE([HAVE_EPOLL], [1], [Define if you have epoll support.]) ===================================== mk/config.mk.in ===================================== @@ -504,6 +504,8 @@ SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ ===================================== testsuite/tests/rts/all.T ===================================== @@ -406,7 +406,7 @@ test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp - test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug']) test('T13676', - [when(opsys('darwin') or opsys('mingw32'), expect_broken(17447)), + [when(opsys('mingw32'), expect_broken(17447)), extra_files(['T13676.hs'])], ghci_script, ['T13676.script']) test('InitEventLogging', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43d845277424642c447a2e4a13e7e1e1903c16a9...80f3f4a6922c2854af941853482998fe27b163db -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/43d845277424642c447a2e4a13e7e1e1903c16a9...80f3f4a6922c2854af941853482998fe27b163db You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 19:43:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 15:43:55 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] testsuite: Update expected output for mod184 Message-ID: <5f568d7badf6a_80b82a9984109283a1@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: f14fc993 by Ben Gamari at 2020-09-07T15:42:04-04:00 testsuite: Update expected output for mod184 An earlier commit (7831fe05021caa90d4696ca91ae2b31a82e65b3d) modified the warning yet one of the build system issues addressed in my earlier commits appears to have been hiding the change from the testsuite. - - - - - 1 changed file: - testsuite/tests/module/mod184.stderr Changes: ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -1,3 +1,5 @@ + mod184.hs:6:8: warning: [-Wprepositive-qualified-module] Found ‘qualified’ in prepositive position Suggested fix: place ‘qualified’ after the module name instead. + To allow this, enable language extension 'ImportQualifiedPost' View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f14fc9931597bc69e3dc9985eb567a0e871be9f7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f14fc9931597bc69e3dc9985eb567a0e871be9f7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 20:20:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 16:20:47 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports2 Message-ID: <5f56961f71861_80b3f8441ba31f0109346a5@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backports2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 20:53:40 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Mon, 07 Sep 2020 16:53:40 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18639-remove-generated-pragma Message-ID: <5f569dd49c004_80b3f84399be5e010939917@gitlab.haskell.org.mail> Alan Zimmerman pushed new branch wip/T18639-remove-generated-pragma at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18639-remove-generated-pragma You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 21:17:53 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 17:17:53 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports Message-ID: <5f56a38140c26_80be81931410943380@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/backports at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 21:17:54 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 17:17:54 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 3 commits: gitlab-ci: More intelligent detection of locale availability Message-ID: <5f56a38225f63_80be819314109435ea@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: 4e8f05fa by Ben Gamari at 2020-09-06T15:27:00-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. (cherry picked from commit be2cc0ad2109894d2f576c73e3f037b6b79a6bdc) - - - - - 104b0ccd by Ben Gamari at 2020-09-07T03:18:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - cee137dc by Ben Gamari at 2020-09-07T03:18:32-04:00 gitlab-ci: Use hadrian builds for Window release artifacts - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -879,13 +879,13 @@ nightly-x86_64-windows: # Normal Windows validate builds are profiled; that won't do for releases. release-x86_64-windows: <<: *release - extends: validate-x86_64-windows + extends: validate-x86_64-windows-hadrian variables: BUILD_FLAVOUR: "perf" - # + release-x86_64-windows-integer-simple: <<: *release - extends: validate-x86_64-windows + extends: validate-x86_64-windows-hadrian variables: BIGNUM_BACKEND: native BUILD_FLAVOUR: "perf" ===================================== .gitlab/ci.sh ===================================== @@ -26,9 +26,6 @@ LT_CYAN="1;36" WHITE="1;37" LT_GRAY="0;37" -export LANG=C.UTF-8 -export LC_ALL=C.UTF-8 - # GitLab Pipelines log section delimiters # https://gitlab.com/gitlab-org/gitlab-foss/issues/14664 start_section() { @@ -60,6 +57,30 @@ function run() { TOP="$(pwd)" +function setup_locale() { + # BSD grep terminates early with -q, consequently locale -a will get a + # SIGPIPE and the pipeline will fail with pipefail. + shopt -o -u pipefail + if locale -a | grep -q C.UTF-8; then + # Debian + export LANG=C.UTF-8 + elif locale -a | grep -q C.utf8; then + # Fedora calls it this + export LANG=C.utf8 + elif locale -a | grep -q en_US.UTF-8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.UTF-8 + else + error "Failed to find usable locale" + info "Available locales:" + locale -a + fail "No usable locale, aborting..." + fi + info "Using locale $LANG..." + export LC_ALL=$LANG + shopt -o -s pipefail +} + function mingw_init() { case "$MSYSTEM" in MINGW32) @@ -406,10 +427,12 @@ function clean() { } function run_hadrian() { + if [ -z "$BIGNUM_BACKEND" ]; then BIGNUM_BACKEND="gmp"; fi run hadrian/build-cabal \ --flavour="$FLAVOUR" \ -j"$cores" \ --broken-test="$BROKEN_TESTS" \ + --bignum=$BIGNUM_BACKEND \ $HADRIAN_ARGS \ $@ } @@ -423,6 +446,8 @@ function shell() { run $cmd } +setup_locale + # Determine Cabal data directory case "$(uname)" in MSYS_*|MINGW*) exe=".exe"; cabal_dir="$APPDATA/cabal" ;; View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2dbdb7b9f3c4f10566072f18d7b5f11a9d330211...cee137dcab0b33915b0add69db9535ef4227f824 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2dbdb7b9f3c4f10566072f18d7b5f11a9d330211...cee137dcab0b33915b0add69db9535ef4227f824 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 22:04:46 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Mon, 07 Sep 2020 18:04:46 -0400 Subject: [Git][ghc/ghc][wip/T18599-split-construct] Merge pbinds into fbinds Message-ID: <5f56ae7e46a42_80b3f84383d23801094619c@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599-split-construct at Glasgow Haskell Compiler / GHC Commits: dde48b77 by Shayne Fletcher at 2020-09-07T18:03:59-04:00 Merge pbinds into fbinds - - - - - 3 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - record-dot-syntax-tests/Test.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -2723,7 +2723,6 @@ aexp1 :: { ECP } $3 >>= \ $3 -> amms (mkHsRecordPV dot (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3)) (moc $2:mcc $4:(fst $3)) } - | aexp1 '{' pbinds '}' {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ applyFieldUpdates $1 $3 } | aexp2 { $1 } aexp2 :: { ECP } @@ -3231,7 +3230,7 @@ fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([Fbind b], Maybe SrcSpan)) } : fbind ',' fbinds1 { $1 >>= \ $1 -> $3 >>= \ $3 -> - addAnnotation (gl (fbindToRecField $1)) AnnComma (gl $2) >> + -- addAnnotation (gl (fbindToRecField $1)) AnnComma (gl $2) >> return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) } | fbind { $1 >>= \ $1 -> return ([],([$1], Nothing)) } @@ -3253,42 +3252,30 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- In the punning case, use a place-holder -- The renamer fills in the final value ------------------------------------------------------------------------------ --- Nested updates (strictly expressions; patterns do not participate in updates). - -pbinds :: { [LHsExpr GhcPs -> LHsExpr GhcPs] } - : pbinds1 { $1 } - -pbinds1 :: { [LHsExpr GhcPs -> LHsExpr GhcPs] } - : pbind ',' pbinds1 { $1 : $3 } - | pbind { [$1] } - -pbind :: { LHsExpr GhcPs -> LHsExpr GhcPs } -- See Note [Whitespace-sensitive operator parsing] in Lexer.x - : field TIGHT_INFIX_PROJ fieldToUpdate '=' texp - {%do { ; let { top = $1 -- foo - ; fields = top : reverse $3 -- [foo, bar, baz, quux] - } - ; arg <- runPV (unECP $5) - ; return $ mkFieldUpdater fields arg - }} + | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp + { unECP $5 >>= \ $5 -> + mkHsFieldUpdaterPV ($1 : reverse $3) $5 >>= \ up -> + return $ Pbind up + } + -- See Note [Whitespace-sensitive operator parsing] in Lexer.x - | field TIGHT_INFIX_PROJ fieldToUpdate - {%do { ; recordPuns <- getBit RecordPunsBit - ; if not recordPuns - then do { - ; addFatalError noSrcSpan $ - text "For this to work, enable NamedFieldPuns." - } - else do { - ; let { ; top = $1 -- foo - ; fields = top : reverse $3 -- [foo, bar, baz, quux] - ; final = last fields -- quux - ; arg = mkVar $ unpackFS (unLoc final) - } - ; return $ mkFieldUpdater fields arg - } - }} + | field TIGHT_INFIX_PROJ fieldToUpdate + { let { ; top = $1 + ; fields = top : reverse $3 + ; final = last fields } + in + getBit RecordPunsBit >>= \ puns -> + if puns + then + let arg = mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final in + mkHsVarPV (noLoc arg) >>= \ var -> + mkHsFieldUpdaterPV fields var >>= \ up -> + return $ Pbind up + else + addFatalError noSrcSpan $ + text "For this to work, enable NamedFieldPuns." + } fieldToUpdate :: { [Located FastString] } fieldToUpdate ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -153,7 +153,7 @@ import Data.Kind ( Type ) #include "HsVersions.h" data Fbind b = - Fbind (LHsRecField GhcPs (Located b)) | Pbind (LHsExpr GhcPs -> LHsExpr GhcPs) + Fbind (LHsRecField GhcPs (Located b)) | Pbind (Located b -> Located b) fbindToRecField :: Fbind b -> LHsRecField GhcPs (Located b) fbindToRecField (Fbind f) = f @@ -1392,6 +1392,8 @@ class b ~ (Body b) GhcPs => DisambECP b where ecpFromCmd' :: LHsCmd GhcPs -> PV (Located b) -- | Return an expression without ambiguity, or fail in a non-expression context. ecpFromExp' :: LHsExpr GhcPs -> PV (Located b) + -- | This can only be satified by expressions. + mkHsFieldUpdaterPV :: [Located FastString] -> Located b -> PV (Located b -> Located b) -- | Disambiguate "\... -> ..." (lambda) mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b) -- | Disambiguate "let ... in ..." @@ -1519,6 +1521,9 @@ instance DisambECP (HsCmd GhcPs) where type Body (HsCmd GhcPs) = HsCmd ecpFromCmd' = return ecpFromExp' (L l e) = cmdFail l (ppr e) + mkHsFieldUpdaterPV _ _ = + cmdFail (noSrcSpan) $ + text "Trying to make a field update in a command context" mkHsLamPV l mg = return $ L l (HsCmdLam noExtField mg) mkHsLetPV l bs e = return $ L l (HsCmdLet noExtField bs e) type InfixOp (HsCmd GhcPs) = HsExpr GhcPs @@ -1582,6 +1587,7 @@ instance DisambECP (HsExpr GhcPs) where nest 2 (ppr c) ] return (L l hsHoleExpr) ecpFromExp' = return + mkHsFieldUpdaterPV fields arg = return $ mkFieldUpdater fields arg mkHsLamPV l mg = return $ L l (HsLam noExtField mg) mkHsLetPV l bs c = return $ L l (HsLet noExtField bs c) type InfixOp (HsExpr GhcPs) = HsExpr GhcPs @@ -1669,6 +1675,9 @@ instance DisambECP (PatBuilder GhcPs) where ecpFromExp' (L l e) = addFatalError l $ text "Expression syntax in pattern:" <+> ppr e + mkHsFieldUpdaterPV _ _ = + addFatalError noSrcSpan $ + text "Trying to make a field update in a pattern context" mkHsLamPV l _ = addFatalError l $ text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." ===================================== record-dot-syntax-tests/Test.hs ===================================== @@ -112,5 +112,4 @@ main = do g <- pure a print $ c{f} -- 42, 1 print $ c{f, g} -- 42, 42 - -- print $ c{f, g.foo.bar.baz.quux = 4} -- Can't mix top-level and nested updates (limitation of this prototype). - print $ c{f}{g.foo.bar.baz.quux = 4} -- Workaround; 42, 4 + print $ c{f, g.foo.bar.baz.quux = 4} -- Can now mix top-level and nested updates! View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dde48b77356c548c6d625344946725f02e8518a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dde48b77356c548c6d625344946725f02e8518a6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 22:05:22 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Mon, 07 Sep 2020 18:05:22 -0400 Subject: [Git][ghc/ghc][wip/T18599] 3 commits: Generalize what the fbind rules produce Message-ID: <5f56aea2a81e5_80b3f847dddc12410948652@gitlab.haskell.org.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: ef97a4a8 by Shayne Fletcher at 2020-09-07T12:47:50-04:00 Generalize what the fbind rules produce - - - - - 52dda663 by Shayne Fletcher at 2020-09-07T14:18:09-04:00 Generalize mkRdrRecordUpd [...] Content analysis details: (5.0 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 RDNS_NONE Delivered to internal network by a host with no rDNS 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: Shayne Fletcher Subject: [Git][ghc/ghc][wip/T18599] 3 commits: Generalize what the fbind rules produce Date: Mon, 07 Sep 2020 18:05:22 -0400 Size: 327414 URL: From gitlab at gitlab.haskell.org Mon Sep 7 22:08:49 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Mon, 07 Sep 2020 18:08:49 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/T18599-split-construct Message-ID: <5f56af71acb96_80b3f8490092bb810950146@gitlab.haskell.org.mail> Shayne Fletcher deleted branch wip/T18599-split-construct at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 22:13:57 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Mon, 07 Sep 2020 18:13:57 -0400 Subject: [Git][ghc/ghc][wip/T16762] WIP: T16762 (part 2) Message-ID: <5f56b0a55736c_80b8d7f4801095035@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T16762 at Glasgow Haskell Compiler / GHC Commits: 8767ff95 by Ryan Scott at 2020-09-07T18:12:59-04:00 WIP: T16762 (part 2) [ci skip] - - - - - 30 changed files: - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Utils.hs - compiler/GHC/Tc/Deriv.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Class.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/ThToHs.hs - testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/patsyn/should_fail/T11039.stderr - testsuite/tests/patsyn/should_fail/T11667.stderr Changes: ===================================== compiler/GHC/Hs/Binds.hs ===================================== @@ -894,7 +894,7 @@ data Sig pass TypeSig (XTypeSig pass) [XRec pass (IdP pass)] -- LHS of the signature; e.g. f,g,h :: blah - (LHsSigWcType pass) -- RHS of the signature; can have wildcards + (LHsSigWcType pass) -- RHS of the signature; can have wildcards -- | A pattern synonym type signature -- @@ -905,7 +905,7 @@ data Sig pass -- 'GHC.Parser.Annotation.AnnDot','GHC.Parser.Annotation.AnnDarrow' -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | PatSynSig (XPatSynSig pass) [XRec pass (IdP pass)] (LHsSigType pass) + | PatSynSig (XPatSynSig pass) [XRec pass (IdP pass)] (LHsSigType' pass) -- P :: forall a b. Req => Prov => ty -- | A signature for a class method @@ -918,7 +918,7 @@ data Sig pass -- -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnDefault', -- 'GHC.Parser.Annotation.AnnDcolon' - | ClassOpSig (XClassOpSig pass) Bool [XRec pass (IdP pass)] (LHsSigType pass) + | ClassOpSig (XClassOpSig pass) Bool [XRec pass (IdP pass)] (LHsSigType' pass) -- | A type signature in generated code, notably the code -- generated for record selectors. We simply record ===================================== compiler/GHC/Hs/Decls.hs ===================================== @@ -1450,7 +1450,7 @@ data ConDecl pass -- Whether or not there is an /explicit/ forall, we still -- need to capture the implicitly-bound type/kind variables -} - , con_bndrs :: Located (HsOuterGadtTyVarBndrs pass) -- ^ TODO RGS: Docs + , con_bndrs :: Located (HsOuterSigTyVarBndrs pass) -- ^ TODO RGS: Docs , con_mb_cxt :: Maybe (LHsContext pass) -- ^ User-written context (if any) , con_args :: HsConDeclDetails pass -- ^ Arguments; never InfixCon @@ -1702,7 +1702,7 @@ pprConDecl (ConDeclGADT { con_names = cons, con_bndrs = L _ outer_bndrs , con_mb_cxt = mcxt, con_args = args , con_res_ty = res_ty, con_doc = doc }) = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon - <+> (sep [pprHsOuterGadtTyVarBndrs outer_bndrs <+> pprLHsContext cxt, + <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext cxt, ppr_arrow_chain (get_args args ++ [ppr res_ty]) ]) where get_args (PrefixCon args) = map ppr args @@ -1873,7 +1873,7 @@ type LClsInstDecl pass = XRec pass (ClsInstDecl pass) data ClsInstDecl pass = ClsInstDecl { cid_ext :: XCClsInstDecl pass - , cid_poly_ty :: LHsSigType pass -- Context => Class Instance-type + , cid_poly_ty :: LHsSigType' pass -- Context => Class Instance-type -- Using a polytype means that the renamer conveniently -- figures out the quantified type variables for us. , cid_binds :: LHsBinds pass -- Class methods @@ -2062,7 +2062,7 @@ type LDerivDecl pass = XRec pass (DerivDecl pass) -- | Stand-alone 'deriving instance' declaration data DerivDecl pass = DerivDecl { deriv_ext :: XCDerivDecl pass - , deriv_type :: LHsSigWcType pass + , deriv_type :: LHsSigWcType' pass -- ^ The instance type to derive. -- -- It uses an 'LHsSigWcType' because the context is allowed to be a @@ -2123,8 +2123,8 @@ data DerivStrategy pass | ViaStrategy (XViaStrategy pass) -- ^ @-XDerivingVia@ -type instance XViaStrategy GhcPs = LHsSigType GhcPs -type instance XViaStrategy GhcRn = LHsSigType GhcRn +type instance XViaStrategy GhcPs = LHsSigType' GhcPs +type instance XViaStrategy GhcRn = LHsSigType' GhcRn type instance XViaStrategy GhcTc = Type instance OutputableBndrId p ===================================== compiler/GHC/Hs/Instances.hs ===================================== @@ -393,10 +393,10 @@ deriving instance Data (LHsQTyVars GhcPs) deriving instance Data (LHsQTyVars GhcRn) deriving instance Data (LHsQTyVars GhcTc) --- deriving instance (DataIdLR p p, Data expBndrs) => Data (HsOuterTyVarBndrs p expBndrs) -deriving instance Data expBndrs => Data (HsOuterTyVarBndrs GhcPs expBndrs) -deriving instance Data expBndrs => Data (HsOuterTyVarBndrs GhcRn expBndrs) -deriving instance Data expBndrs => Data (HsOuterTyVarBndrs GhcTc expBndrs) +-- deriving instance (DataIdLR p p, Data flag) => Data (HsOuterTyVarBndrs flag p) +deriving instance Data flag => Data (HsOuterTyVarBndrs flag GhcPs) +deriving instance Data flag => Data (HsOuterTyVarBndrs flag GhcRn) +deriving instance Data flag => Data (HsOuterTyVarBndrs flag GhcTc) -- deriving instance (DataIdLR p p, Data thing) =>Data (HsImplicitBndrs p thing) deriving instance (Data thing) => Data (HsImplicitBndrs GhcPs thing) ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -30,11 +30,10 @@ module GHC.Hs.Type ( HsType(..), NewHsTypeX(..), LHsType, HsKind, LHsKind, HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr, LHsQTyVars(..), - HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, - HsOuterGadtTyVarBndrs, HsOuterSigTyVarBndrs, + HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs, HsImplicitBndrs(..), HsWildCardBndrs(..), HsPatSigType(..), HsPSRn(..), - LHsSigType, HsSigType(..), LHsSigType', LHsSigWcType, LHsWcType, + LHsSigType, HsSigType(..), LHsSigType', LHsSigWcType, LHsSigWcType', LHsWcType, HsTupleSort(..), HsContext, LHsContext, noLHsContext, HsTyLit(..), @@ -61,28 +60,29 @@ module GHC.Hs.Type ( mkHsOuterImplicit, mkHsOuterExplicit, mapXHsOuterImplicit, mkHsImplicitSigType, mkHsExplicitSigType, + hsSigTypeToHsType, hsTypeToHsSigType, hsTypeToHsSigWcType, mkHsImplicitBndrs, mkHsWildCardBndrs, mkHsPatSigType, hsImplicitBody, mkEmptyImplicitBndrs, mkEmptyWildCardBndrs, mkHsForAllVisTele, mkHsForAllInvisTele, mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy, - hsScopedTvs, hsScopedTvs', hsWcScopedTvs, dropWildCards, + hsScopedTvs, hsScopedTvs', hsWcScopedTvs, hsWcScopedTvs', dropWildCards, dropWildCards', hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames, - splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclHead', getLHsInstDeclClass_maybe, - splitLHsPatSynTy, + splitLHsInstDeclTy, splitLHsInstDeclTy', getLHsInstDeclHead, getLHsInstDeclHead', getLHsInstDeclClass_maybe, getLHsInstDeclClass_maybe', + splitLHsPatSynTy, splitLHsPatSynTy', splitLHsForAllTyInvis, splitLHsForAllTyInvis_KP, splitLHsQualTy, splitLHsSigmaTyInvis, splitLHsGadtTy, splitHsFunType, hsTyGetAppHead_maybe, mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppKindTy, - ignoreParens, hsSigType, hsSigWcType, hsPatSigType, + ignoreParens, hsSigType, hsSigWcType, hsSigWcTypeBody, hsPatSigType, hsTyKindSig, hsConDetailsArgs, setHsTyVarBndrFlag, hsTyVarBndrFlag, -- Printing pprHsType, pprHsForAll, - pprHsOuterFamEqnTyVarBndrs, pprHsOuterGadtTyVarBndrs, + pprHsOuterFamEqnTyVarBndrs, pprHsOuterSigTyVarBndrs, pprLHsContext, hsTypeNeedsParens, parenthesizeHsType, parenthesizeHsContext ) where @@ -415,25 +415,20 @@ emptyLHsQTvs = HsQTvs { hsq_ext = [], hsq_explicit = [] } -- * Patterns in a type/data family instance (HsTyPats) -- | TODO RGS: Docs -data HsOuterTyVarBndrs pass expBndrs +data HsOuterTyVarBndrs flag pass = HsOuterImplicit { hso_ximplicit :: XHsOuterImplicit pass } | HsOuterExplicit { hso_xexplicit :: XHsOuterExplicit pass - , hso_bndrs :: expBndrs + , hso_bndrs :: [LHsTyVarBndr flag pass] } | XHsOuterTyVarBndrs !(XXHsOuterTyVarBndrs pass) -- | TODO RGS: Docs -type HsOuterFamEqnTyVarBndrs pass = - HsOuterTyVarBndrs pass [LHsTyVarBndr () pass] +type HsOuterFamEqnTyVarBndrs = HsOuterTyVarBndrs () -- | TODO RGS: Docs -type HsOuterGadtTyVarBndrs pass = - HsOuterTyVarBndrs pass [LHsTyVarBndr Specificity pass] --- | TODO RGS: Docs -type HsOuterSigTyVarBndrs pass = - HsOuterTyVarBndrs pass (HsForAllTelescope pass) +type HsOuterSigTyVarBndrs = HsOuterTyVarBndrs Specificity type instance XHsOuterImplicit GhcPs = NoExtField type instance XHsOuterImplicit GhcRn = [Name] @@ -536,17 +531,27 @@ type LHsWcType pass = HsWildCardBndrs pass (LHsType pass) -- Wildcard only -- | Located Haskell Signature Wildcard Type type LHsSigWcType pass = HsWildCardBndrs pass (LHsSigType pass) -- Both +-- | TODO RGS: This is the REAL LHsSigWcType. Delete the one above when ready. +type LHsSigWcType' pass = HsWildCardBndrs pass (LHsSigType' pass) -- Both + -- See Note [Representing type signatures] +-- TODO RGS: Delete this hsImplicitBody :: HsImplicitBndrs (GhcPass p) thing -> thing hsImplicitBody (HsIB { hsib_body = body }) = body +-- TODO RGS: Delete this hsSigType :: LHsSigType (GhcPass p) -> LHsType (GhcPass p) hsSigType = hsImplicitBody +-- TODO RGS: Delete this? hsSigWcType :: LHsSigWcType pass -> LHsType pass hsSigWcType sig_ty = hsib_body (hswc_body sig_ty) +-- TODO RGS: This is the REAL hsSigWcType. Delete the one above when ready. +hsSigWcTypeBody :: LHsSigWcType' pass -> LHsType pass +hsSigWcTypeBody = sig_body . unLoc . hswc_body + hsPatSigType :: HsPatSigType pass -> LHsType pass hsPatSigType = hsps_body @@ -554,6 +559,11 @@ dropWildCards :: LHsSigWcType pass -> LHsSigType pass -- Drop the wildcard part of a LHsSigWcType dropWildCards sig_ty = hswc_body sig_ty +-- TODO RGS: This is the REAL dropWildCards. Delete the one above when ready. +dropWildCards' :: LHsSigWcType' pass -> LHsSigType' pass +-- Drop the wildcard part of a LHsSigWcType +dropWildCards' sig_ty = hswc_body sig_ty + {- Note [Representing type signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ HsSigType is used to represent an explicit user type signature @@ -639,16 +649,16 @@ variables so that they can be brought into scope during renaming and typechecking. -} -mkHsOuterImplicit :: HsOuterTyVarBndrs GhcPs expBndrs +mkHsOuterImplicit :: HsOuterTyVarBndrs flag GhcPs mkHsOuterImplicit = HsOuterImplicit { hso_ximplicit = noExtField } -mkHsOuterExplicit :: expBndrs -> HsOuterTyVarBndrs GhcPs expBndrs +mkHsOuterExplicit :: [LHsTyVarBndr flag GhcPs] -> HsOuterTyVarBndrs flag GhcPs mkHsOuterExplicit exp_bndrs = HsOuterExplicit { hso_xexplicit = noExtField , hso_bndrs = exp_bndrs } mapXHsOuterImplicit :: (XHsOuterImplicit pass -> XHsOuterImplicit pass) - -> HsOuterTyVarBndrs pass expBndrs -> HsOuterTyVarBndrs pass expBndrs + -> HsOuterTyVarBndrs flag pass -> HsOuterTyVarBndrs flag pass mapXHsOuterImplicit f (HsOuterImplicit { hso_ximplicit = ximplicit }) = HsOuterImplicit { hso_ximplicit = f ximplicit } mapXHsOuterImplicit _ hso at HsOuterExplicit{} = hso @@ -659,11 +669,36 @@ mkHsImplicitSigType body = HsSig { sig_ext = noExtField , sig_bndrs = mkHsOuterImplicit, sig_body = body } -mkHsExplicitSigType :: HsForAllTelescope GhcPs -> LHsType GhcPs +mkHsExplicitSigType :: [LHsTyVarBndr Specificity GhcPs] -> LHsType GhcPs -> HsSigType GhcPs -mkHsExplicitSigType tele body = +mkHsExplicitSigType bndrs body = HsSig { sig_ext = noExtField - , sig_bndrs = mkHsOuterExplicit tele, sig_body = body } + , sig_bndrs = mkHsOuterExplicit bndrs, sig_body = body } + +-- TODO RGS: Delete this crap +hsSigTypeToHsType :: LHsSigType' GhcPs -> LHsType GhcPs +hsSigTypeToHsType (L l (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) = + case outer_bndrs of + HsOuterImplicit{} -> body + HsOuterExplicit{hso_bndrs = exp_bndrs} -> + L l $ HsForAllTy { hst_xforall = noExtField + , hst_tele = mkHsForAllInvisTele exp_bndrs, hst_body = body } + +-- TODO RGS: Docs +-- TODO RGS: Consider moving this to GHC.Hs.Utils instead, as it is somewhat analogous +-- to mkLHsSigType +hsTypeToHsSigType :: LHsType GhcPs -> LHsSigType' GhcPs +hsTypeToHsSigType lty@(L loc ty) = L loc $ case ty of + HsForAllTy { hst_tele = HsForAllInvis { hsf_invis_bndrs = bndrs } + , hst_body = body } + -> mkHsExplicitSigType bndrs body + _ -> mkHsImplicitSigType lty + +-- TODO RGS: Docs +-- TODO RGS: Consider moving this to GHC.Hs.Utils instead, as it is somewhat analogous +-- to mkLHsSigWcType +hsTypeToHsSigWcType :: LHsType GhcPs -> LHsSigWcType' GhcPs +hsTypeToHsSigWcType = mkHsWildCardBndrs . hsTypeToHsSigType mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing mkHsImplicitBndrs x = HsIB { hsib_ext = noExtField @@ -1241,6 +1276,21 @@ hsWcScopedTvs sig_ty vars ++ nwcs ++ hsLTyVarNames tvs _ -> nwcs +-- TODO RGS: This is the REAL hsWcScopedTvs. Delete the one above when ready. +hsWcScopedTvs' :: LHsSigWcType' GhcRn -> [Name] +-- Get the lexically-scoped type variables of a HsSigType +-- - the explicitly-given forall'd type variables +-- - the named wildcards; see Note [Scoping of named wildcards] +-- because they scope in the same way +hsWcScopedTvs' sig_wc_ty + | HsWC { hswc_ext = nwcs, hswc_body = sig_ty } <- sig_wc_ty + , L _ (HsSig{sig_bndrs = outer_bndrs}) <- sig_ty + = case outer_bndrs of + HsOuterImplicit{} -> + nwcs + HsOuterExplicit{hso_bndrs = tvs} -> + nwcs ++ hsLTyVarNames tvs -- See Note [hsScopedTvs vis_flag] + -- TODO RGS: Delete this hsScopedTvs :: LHsSigType GhcRn -> [Name] -- Same as hsWcScopedTvs, but for a LHsSigType @@ -1257,13 +1307,10 @@ hsScopedTvs sig_ty hsScopedTvs' :: LHsSigType' GhcRn -> [Name] -- Same as hsWcScopedTvs, but for a LHsSigType hsScopedTvs' (L _ (HsSig{sig_bndrs = outer_bndrs})) = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = vars} - -> vars - HsOuterExplicit{hso_bndrs = exp_bndrs} -> case exp_bndrs of - HsForAllInvis{hsf_invis_bndrs = invis_bndrs} - -> hsLTyVarNames invis_bndrs -- See Note [hsScopedTvs vis_flag] - HsForAllVis{} - -> [] + HsOuterImplicit{} -> + [] + HsOuterExplicit{hso_bndrs = tvs} -> + hsLTyVarNames tvs -- See Note [hsScopedTvs vis_flag] {- Note [Scoping of named wildcards] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1513,6 +1560,28 @@ splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4) (exis, ty3) = splitLHsForAllTyInvis ty2 (provs, ty4) = splitLHsQualTy ty3 +-- TODO RGS: This is the REAL splitLHsPatSynTy. Delete the one above when ready. +splitLHsPatSynTy' :: LHsSigType' (GhcPass p) + -> ( [LHsTyVarBndr Specificity (GhcPass p)] -- universals + , LHsContext (GhcPass p) -- required constraints + , [LHsTyVarBndr Specificity (GhcPass p)] -- existentials + , LHsContext (GhcPass p) -- provided constraints + , LHsType (GhcPass p)) -- body type +splitLHsPatSynTy' ty = (univs, reqs, exis, provs, ty4) + where + split_sig_ty :: LHsSigType' (GhcPass p) + -> ([LHsTyVarBndr Specificity (GhcPass p)], LHsType (GhcPass p)) + split_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) = + case outer_bndrs of + HsOuterImplicit{} -> ([], ignoreParens body) + -- TODO RGS: Sigh. Explain why ignoreParens is necessary here. + HsOuterExplicit{hso_bndrs = exp_bndrs} -> (exp_bndrs, body) + + (univs, ty1) = split_sig_ty ty + (reqs, ty2) = splitLHsQualTy ty1 + (exis, ty3) = splitLHsForAllTyInvis ty2 + (provs, ty4) = splitLHsQualTy ty3 + -- | Decompose a sigma type (of the form @forall . context => body@) -- into its constituent parts. -- Only splits type variable binders that were @@ -1568,44 +1637,19 @@ splitLHsSigmaTyInvis_KP ty -- This function is careful not to look through parentheses. -- See @Note [GADT abstract syntax] (Wrinkle: No nested foralls or contexts)@ -- "GHC.Hs.Decls" for why this is important. -{- --- TODO RGS: Delete me? - -splitLHsGadtTy :: - LHsType (GhcPass pass) - -> (Maybe [LHsTyVarBndr Specificity (GhcPass pass)], Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass)) -splitLHsGadtTy = splitLHsSigmaTyInvis_KP --} --- TODO RGS: Delete me? - splitLHsGadtTy :: -- TODO RGS: Delete me? LHsSigType' GhcPs - -> (HsOuterGadtTyVarBndrs GhcPs, Maybe (LHsContext GhcPs), LHsType GhcPs) -{- --- TODO RGS: Delete me? - - LHsSigType' (GhcPass pass) - -> (HsOuterGadtTyVarBndrs (GhcPass pass), Maybe (LHsContext (GhcPass pass)), LHsType (GhcPass pass)) --} -splitLHsGadtTy (L l sig_ty) + -> (HsOuterSigTyVarBndrs GhcPs, Maybe (LHsContext GhcPs), LHsType GhcPs) +splitLHsGadtTy (L _ sig_ty) | (outer_bndrs, rho_ty) <- split_bndrs sig_ty , (mb_ctxt, tau_ty) <- splitLHsQualTy_KP rho_ty = (outer_bndrs, mb_ctxt, tau_ty) where - split_bndrs (HsSig { sig_bndrs = outer_bndrs, sig_body = body_ty}) = case outer_bndrs of - HsOuterImplicit{} -> - (mkHsOuterImplicit, body_ty) - HsOuterExplicit{hso_bndrs = tele} -> case tele of - HsForAllInvis{hsf_invis_bndrs = bndrs} -> - (mkHsOuterExplicit bndrs, body_ty) - -- TODO RGS: Say more here. In particular, rather than throwing an - -- error here, we let addNoNestedForallsContextsErr catch this later. - HsForAllVis{} -> - ( mkHsOuterImplicit - , L l $ HsForAllTy { hst_xforall = noExtField - , hst_tele = tele, hst_body = body_ty }) + split_bndrs :: HsSigType GhcPs -> (HsOuterSigTyVarBndrs GhcPs, LHsType GhcPs) + split_bndrs (HsSig { sig_bndrs = outer_bndrs, sig_body = body_ty}) = + (outer_bndrs, body_ty) -- | Decompose a type of the form @forall . body@ into its constituent -- parts. Only splits type variable binders that @@ -1694,6 +1738,19 @@ splitLHsInstDeclTy (HsIB { hsib_ext = itkvs -- the other into scope over the bodies of the instance methods, so we -- simply combine them into a single list. +-- TODO RGS: This is the REAL splitLHsInstDeclTy. Delete the one above when ready. +splitLHsInstDeclTy' :: LHsSigType' GhcRn + -> ([Name], LHsContext GhcRn, LHsType GhcRn) +splitLHsInstDeclTy' (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = inst_ty})) = + case outer_bndrs of + HsOuterImplicit{hso_ximplicit = imp_tkvs} -> + (imp_tkvs, ctxt, body_ty) + HsOuterExplicit{hso_bndrs = exp_bndrs} -> + (hsLTyVarNames exp_bndrs, ctxt, body_ty) + where + (mb_cxt, body_ty) = splitLHsQualTy_KP inst_ty + ctxt = fromMaybe noLHsContext mb_cxt + -- | Decompose a type class instance type (of the form -- @forall . context => instance_head@) into the @instance_head at . getLHsInstDeclHead :: LHsSigType (GhcPass p) -> LHsType (GhcPass p) @@ -1718,6 +1775,15 @@ getLHsInstDeclClass_maybe inst_ty ; cls <- hsTyGetAppHead_maybe head_ty ; return cls } +-- TODO RGS: This the REAL getLHsInstDeclClass_maybe. Delete the one above when ready. +getLHsInstDeclClass_maybe' :: LHsSigType' (GhcPass p) + -> Maybe (Located (IdP (GhcPass p))) +-- Works on (LHsSigType GhcPs) +getLHsInstDeclClass_maybe' inst_ty + = do { let head_ty = getLHsInstDeclHead' inst_ty + ; cls <- hsTyGetAppHead_maybe head_ty + ; return cls } + {- Note [No nested foralls or contexts in instance types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1927,8 +1993,8 @@ instance OutputableBndrId p => Outputable (LHsQTyVars (GhcPass p)) where ppr (HsQTvs { hsq_explicit = tvs }) = interppSP tvs -instance forall p expBndrs. (OutputableBndrId p, Outputable expBndrs) - => Outputable (HsOuterTyVarBndrs (GhcPass p) expBndrs) where +instance forall flag p. (OutputableBndrFlag flag, OutputableBndrId p) + => Outputable (HsOuterTyVarBndrs flag (GhcPass p)) where ppr (HsOuterImplicit { hso_ximplicit = implicit_vars }) = text "HsOuterImplicit" <> case ghcPass @p of GhcPs -> empty @@ -1972,21 +2038,14 @@ pprHsOuterFamEqnTyVarBndrs (HsOuterImplicit{}) = empty pprHsOuterFamEqnTyVarBndrs (HsOuterExplicit{hso_bndrs = qtvs}) = forAllLit <+> interppSP qtvs <> dot --- | TODO RGS: Docs -pprHsOuterGadtTyVarBndrs :: OutputableBndrId p - => HsOuterGadtTyVarBndrs (GhcPass p) -> SDoc -pprHsOuterGadtTyVarBndrs (HsOuterImplicit{}) = empty -pprHsOuterGadtTyVarBndrs (HsOuterExplicit{hso_bndrs = bndrs}) = - pprHsForAll (mkHsForAllInvisTele bndrs) noLHsContext - -- TODO RGS: The use of mkHsForAllInvisTele above is a mite bit fishy. - -- Consider carefully if this is the best design. - -- | TODO RGS: Docs pprHsOuterSigTyVarBndrs :: OutputableBndrId p => HsOuterSigTyVarBndrs (GhcPass p) -> SDoc pprHsOuterSigTyVarBndrs (HsOuterImplicit{}) = empty -pprHsOuterSigTyVarBndrs (HsOuterExplicit{hso_bndrs = tele}) = - pprHsForAll tele noLHsContext +pprHsOuterSigTyVarBndrs (HsOuterExplicit{hso_bndrs = bndrs}) = + pprHsForAll (mkHsForAllInvisTele bndrs) noLHsContext + -- TODO RGS: The use of mkHsForAllInvisTele above is a mite bit fishy. + -- Consider carefully if this is the best design. -- | Prints a forall; When passed an empty list, prints @forall .@/@forall ->@ -- only when @-dppr-debug@ is enabled. ===================================== compiler/GHC/Hs/Utils.hs ===================================== @@ -657,6 +657,7 @@ chunkify xs mkLHsSigType :: LHsType GhcPs -> LHsSigType GhcPs mkLHsSigType ty = mkHsImplicitBndrs ty +-- TODO RGS: DELETE THIS mkLHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs mkLHsSigWcType ty = mkHsWildCardBndrs (mkHsImplicitBndrs ty) @@ -694,7 +695,7 @@ mkClassOpSigs sigs = map fiddle sigs where fiddle (L loc (TypeSig _ nms ty)) - = L loc (ClassOpSig noExtField False nms (dropWildCards ty)) + = L loc (ClassOpSig noExtField False nms (hsTypeToHsSigType (hsSigWcType ty))) fiddle sig = sig {- ********************************************************************* ===================================== compiler/GHC/HsToCore/Docs.hs ===================================== @@ -141,7 +141,7 @@ sigNameNoLoc _ = [] -- instanceMap. getInstLoc :: InstDecl (GhcPass p) -> SrcSpan getInstLoc = \case - ClsInstD _ (ClsInstDecl { cid_poly_ty = ty }) -> getLoc (hsSigType ty) + ClsInstD _ (ClsInstDecl { cid_poly_ty = ty }) -> getLoc ty -- The Names of data and type family instances have their SrcSpan's attached -- to the *type constructor*. For example, the Name "D:R:Foo:Int" would have -- its SrcSpan attached here: @@ -246,8 +246,8 @@ classDecls class_ = filterDecls . collectDocs . sortLocated $ decls declTypeDocs :: HsDecl GhcRn -> Map Int (HsDocString) declTypeDocs = \case SigD _ (TypeSig _ _ ty) -> typeDocs (unLoc (hsSigWcType ty)) - SigD _ (ClassOpSig _ _ _ ty) -> typeDocs (unLoc (hsSigType ty)) - SigD _ (PatSynSig _ _ ty) -> typeDocs (unLoc (hsSigType ty)) + SigD _ (ClassOpSig _ _ _ ty) -> sigTypeDocs (unLoc ty) + SigD _ (PatSynSig _ _ ty) -> sigTypeDocs (unLoc ty) ForD _ (ForeignImport _ _ ty _) -> sigTypeDocs (unLoc ty) TyClD _ (SynDecl { tcdRhs = ty }) -> typeDocs (unLoc ty) _ -> M.empty ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -346,9 +346,9 @@ get_scoped_tvs (L _ signature) | TypeSig _ _ sig <- signature = get_scoped_tvs_from_sig (hswc_body sig) | ClassOpSig _ _ _ sig <- signature - = get_scoped_tvs_from_sig sig + = get_scoped_tvs_from_sig' sig | PatSynSig _ _ sig <- signature - = get_scoped_tvs_from_sig sig + = get_scoped_tvs_from_sig' sig | otherwise = [] @@ -367,6 +367,20 @@ get_scoped_tvs_from_sig sig , (explicit_vars, _) <- splitLHsForAllTyInvis hs_ty = implicit_vars ++ hsLTyVarNames explicit_vars +-- TODO RGS: This is the REAL get_scoped_tvs_from_sig'. Delete the one above when ready. +get_scoped_tvs_from_sig' :: LHsSigType' GhcRn -> [Name] + -- Collect both implicit and explicit quantified variables, since + -- the types in instance heads, as well as `via` types in DerivingVia, can + -- bring implicitly quantified type variables into scope, e.g., + -- + -- instance Foo [a] where + -- m = n @a + -- + -- See also Note [Scoped type variables in quotes] +get_scoped_tvs_from_sig' (L _ (HsSig{sig_bndrs = outer_bndrs})) = case outer_bndrs of + HsOuterImplicit{hso_ximplicit = imp_tv_names} -> imp_tv_names + HsOuterExplicit{hso_bndrs = exp_tvs} -> hsLTyVarNames exp_tvs + {- Notes Note [Scoped type variables in quotes] @@ -669,7 +683,7 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds ; decls2 <- repInst rOver cxt1 inst_ty1 decls1 ; wrapGenSyms ss decls2 } where - (tvs, cxt, inst_ty) = splitLHsInstDeclTy ty + (tvs, cxt, inst_ty) = splitLHsInstDeclTy' ty repStandaloneDerivD :: LDerivDecl GhcRn -> MetaM (SrcSpan, Core (M TH.Dec)) repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat @@ -681,7 +695,7 @@ repStandaloneDerivD (L loc (DerivDecl { deriv_strategy = strat ; repDeriv strat' cxt' inst_ty' } ; return (loc, dec) } where - (tvs, cxt, inst_ty) = splitLHsInstDeclTy (dropWildCards ty) + (tvs, cxt, inst_ty) = splitLHsInstDeclTy' (dropWildCards' ty) repTyFamInstD :: TyFamInstDecl GhcRn -> MetaM (Core (M TH.Dec)) repTyFamInstD (TyFamInstDecl { tfid_eqn = eqn }) @@ -695,13 +709,6 @@ repTyFamEqn (FamEqn { feqn_tycon = tc_name , feqn_fixity = fixity , feqn_rhs = rhs }) = do { tc <- lookupLOcc tc_name -- See note [Binders and occurrences] - {- - TODO RGS: Delete me - - ; let hs_tvs = HsQTvs { hsq_ext = var_names - , hsq_explicit = fromMaybe [] mb_bndrs } - ; addTyClTyVarBinds hs_tvs $ \ _ -> - -} ; addHsOuterFamEqnTyVarBinds outer_bndrs $ \mb_exp_bndrs -> do { tys1 <- case fixity of Prefix -> repTyArgs (repNamedTyCon tc) tys @@ -733,13 +740,6 @@ repDataFamInstD (DataFamInstDecl { dfid_eqn = , feqn_fixity = fixity , feqn_rhs = defn }}) = do { tc <- lookupLOcc tc_name -- See note [Binders and occurrences] - {- - TODO RGS: Delete - - ; let hs_tvs = HsQTvs { hsq_ext = var_names - , hsq_explicit = fromMaybe [] mb_bndrs } - ; addTyClTyVarBinds hs_tvs $ \ _ -> - -} ; addHsOuterFamEqnTyVarBinds outer_bndrs $ \mb_exp_bndrs -> do { tys1 <- case fixity of Prefix -> repTyArgs (repNamedTyCon tc) tys @@ -907,26 +907,16 @@ repC (L _ (ConDeclGADT { con_names = cons = repGadtDataCons cons args res_ty | otherwise - = addHsOuterGadtTyVarBinds outer_bndrs $ \ th_outer_bndrs -> + = addHsOuterSigTyVarBinds outer_bndrs $ \ outer_bndrs' -> -- See Note [Don't quantify implicit type variables in quotes] - do { ex_bndrs <- case th_outer_bndrs of - Nothing -> coreListM tyVarBndrSpecTyConName [] - Just invis_bndrs -> pure invis_bndrs - ; c' <- repGadtDataCons cons args res_ty + do { c' <- repGadtDataCons cons args res_ty ; ctxt' <- repMbContext mcxt ; if null_outer_exp_tvs && isNothing mcxt then return c' - else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c']) } + else rep2 forallCName ([unC outer_bndrs', unC ctxt', unC c']) } where - null_outer_imp_tvs = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = imp_bndrs} -> null imp_bndrs - HsOuterExplicit{} -> True - -- Vacuously true, as there is no implicit quantification - - null_outer_exp_tvs = case outer_bndrs of - HsOuterExplicit{hso_bndrs = exp_bndrs} -> null exp_bndrs - HsOuterImplicit{} -> True - -- Vacuously true, as there is no outermost explicit quantification + null_outer_imp_tvs = nullOuterImplicit outer_bndrs + null_outer_exp_tvs = nullOuterExplicit outer_bndrs repMbContext :: Maybe (LHsContext GhcRn) -> MetaM (Core (M TH.Cxt)) repMbContext Nothing = repContext [] @@ -1002,10 +992,10 @@ rep_sig :: LSig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))] rep_sig (L loc (TypeSig _ nms ty)) = mapM (rep_wc_ty_sig sigDName loc ty) nms rep_sig (L loc (PatSynSig _ nms ty)) - = mapM (rep_patsyn_ty_sig loc ty) nms + = mapM (rep_patsyn_ty_sig' loc ty) nms rep_sig (L loc (ClassOpSig _ is_deflt nms ty)) - | is_deflt = mapM (rep_ty_sig defaultSigDName loc ty) nms - | otherwise = mapM (rep_ty_sig sigDName loc ty) nms + | is_deflt = mapM (rep_ty_sig_ defaultSigDName loc ty) nms + | otherwise = mapM (rep_ty_sig_ sigDName loc ty) nms rep_sig d@(L _ (IdSig {})) = pprPanic "rep_sig IdSig" (ppr d) rep_sig (L loc (FixSig _ fix_sig)) = rep_fix_d loc fix_sig rep_sig (L loc (InlineSig _ nm ispec))= rep_inline nm ispec loc @@ -1029,6 +1019,16 @@ rep_ty_sig_tvs explicit_tvs -- NB: Don't pass any implicit type variables to repList above -- See Note [Don't quantify implicit type variables in quotes] +-- TODO RGS: This is the REAL rep_ty_sig_tvs. Delete the one above when ready. +rep_ty_sig_tvs' :: HsOuterSigTyVarBndrs GhcRn + -> MetaM (Core [M TH.TyVarBndrSpec]) +rep_ty_sig_tvs' (HsOuterImplicit{}) = + coreListM tyVarBndrSpecTyConName [] + -- See Note [Don't quantify implicit type variables in quotes] +rep_ty_sig_tvs' (HsOuterExplicit{hso_bndrs = explicit_tvs}) = + repListM tyVarBndrSpecTyConName repTyVarBndr + explicit_tvs + -- Desugar a top-level type signature. Unlike 'repHsSigType', this -- deliberately avoids gensymming the type variables. -- See Note [Scoped type variables in quotes] @@ -1057,6 +1057,27 @@ rep_ty_sig' sig_ty then return th_ty else repTForall th_explicit_tvs th_ctxt th_ty } +-- TODO RGS: This is the REAL rep_ty_sig. Delete the one above when ready. +rep_ty_sig_ :: Name -> SrcSpan -> LHsSigType' GhcRn -> Located Name + -> MetaM (SrcSpan, Core (M TH.Dec)) +rep_ty_sig_ mk_sig loc sig_ty nm + = do { nm1 <- lookupLOcc nm + ; ty1 <- rep_ty_sig'_ sig_ty + ; sig <- repProto mk_sig nm1 ty1 + ; return (loc, sig) } + +-- TODO RGS: This is the REAL rep_ty_sig'. Delete the one above when ready. +rep_ty_sig'_ :: LHsSigType' GhcRn + -> MetaM (Core (M TH.Type)) +rep_ty_sig'_ (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) + | (ctxt, tau) <- splitLHsQualTy body + = do { th_explicit_tvs <- rep_ty_sig_tvs' outer_bndrs + ; th_ctxt <- repLContext ctxt + ; th_tau <- repLTy tau + ; if nullOuterExplicit outer_bndrs && null (unLoc ctxt) + then return th_tau + else repTForall th_explicit_tvs th_ctxt th_tau } + rep_patsyn_ty_sig :: SrcSpan -> LHsSigType GhcRn -> Located Name -> MetaM (SrcSpan, Core (M TH.Dec)) -- represents a pattern synonym type signature; @@ -1080,11 +1101,40 @@ rep_patsyn_ty_sig loc sig_ty nm ; sig <- repProto patSynSigDName nm1 ty1 ; return (loc, sig) } +-- TODO RGS: This is the REAL rep_patsyn_ty_sig. Delete the one above when ready. +rep_patsyn_ty_sig' :: SrcSpan -> LHsSigType' GhcRn -> Located Name + -> MetaM (SrcSpan, Core (M TH.Dec)) +-- represents a pattern synonym type signature; +-- see Note [Pattern synonym type signatures and Template Haskell] in "GHC.ThToHs" +-- +-- Don't create the implicit and explicit variables when desugaring signatures, +-- see Note [Scoped type variables in quotes] +-- and Note [Don't quantify implicit type variables in quotes] +rep_patsyn_ty_sig' loc sig_ty nm + | (univs, reqs, exis, provs, ty) <- splitLHsPatSynTy' sig_ty + = do { nm1 <- lookupLOcc nm + ; th_univs <- rep_ty_sig_tvs univs + ; th_exis <- rep_ty_sig_tvs exis + + ; th_reqs <- repLContext reqs + ; th_provs <- repLContext provs + ; th_ty <- repLTy ty + ; ty1 <- repTForall th_univs th_reqs =<< + repTForall th_exis th_provs th_ty + ; sig <- repProto patSynSigDName nm1 ty1 + ; return (loc, sig) } + rep_wc_ty_sig :: Name -> SrcSpan -> LHsSigWcType GhcRn -> Located Name -> MetaM (SrcSpan, Core (M TH.Dec)) rep_wc_ty_sig mk_sig loc sig_ty nm = rep_ty_sig mk_sig loc (hswc_body sig_ty) nm +-- TODO RGS: This is the REAL rep_wc_ty_sig. Delete the one above when ready. +rep_wc_ty_sig' :: Name -> SrcSpan -> LHsSigWcType' GhcRn -> Located Name + -> MetaM (SrcSpan, Core (M TH.Dec)) +rep_wc_ty_sig' mk_sig loc sig_ty nm + = rep_ty_sig_ mk_sig loc (hswc_body sig_ty) nm + rep_inline :: Located Name -> InlinePragma -- Never defaultInlinePragma -> SrcSpan @@ -1192,17 +1242,28 @@ addHsOuterFamEqnTyVarBinds outer_bndrs thing_inside = do mk_qtvs imp_tvs exp_tvs = HsQTvs { hsq_ext = imp_tvs , hsq_explicit = exp_tvs } -addHsOuterGadtTyVarBinds :: - HsOuterGadtTyVarBndrs GhcRn - -- TODO RGS: Turn that argument into type Core [M TH.TyVarBndrSpec]. It's easier that way, - -- and more consistent with what addHsOuterFamEqnTyVarBinds does. - -> (Maybe (Core [M TH.TyVarBndrSpec]) -> MetaM (Core (M a))) +addHsOuterSigTyVarBinds :: + HsOuterSigTyVarBndrs GhcRn + -> (Core [M TH.TyVarBndrSpec] -> MetaM (Core (M a))) -> MetaM (Core (M a)) -addHsOuterGadtTyVarBinds outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = imp_tvs} -> - addSimpleTyVarBinds imp_tvs $ thing_inside Nothing +addHsOuterSigTyVarBinds outer_bndrs thing_inside = case outer_bndrs of + HsOuterImplicit{hso_ximplicit = imp_tvs} -> do + th_nil <- coreListM tyVarBndrSpecTyConName [] + addSimpleTyVarBinds imp_tvs $ thing_inside th_nil HsOuterExplicit{hso_bndrs = exp_bndrs} -> - addHsTyVarBinds exp_bndrs $ thing_inside . Just + addHsTyVarBinds exp_bndrs thing_inside + +-- TODO RGS: Docs +nullOuterImplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool +nullOuterImplicit (HsOuterImplicit{hso_ximplicit = imp_bndrs}) = null imp_bndrs +nullOuterImplicit (HsOuterExplicit{}) = True + -- Vacuously true, as there is no implicit quantification + +-- TODO RGS: Docs +nullOuterExplicit :: HsOuterSigTyVarBndrs GhcRn -> Bool +nullOuterExplicit (HsOuterExplicit{hso_bndrs = exp_bndrs}) = null exp_bndrs +nullOuterExplicit (HsOuterImplicit{}) = True + -- Vacuously true, as there is no outermost explicit quantification addSimpleTyVarBinds :: [Name] -- the binders to be added -> MetaM (Core (M a)) -- action in the ext env @@ -1307,25 +1368,14 @@ repLHsSigType lsig_ty = repHsSigType' (unLoc lsig_ty) -- TODO RGS: This is the REAL repHsSigType. Delete the one above when ready repHsSigType' :: HsSigType GhcRn -> MetaM (Core (M TH.Type)) -repHsSigType' (HsSig { sig_bndrs = outer_bndrs, sig_body = body }) = - case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tvs} -> - addSimpleTyVarBinds implicit_tvs $ repLTy body - HsOuterExplicit{hso_bndrs = tele} -> case tele of - HsForAllInvis{hsf_invis_bndrs = invis_bndrs} -> - addHsTyVarBinds invis_bndrs $ \ th_invis_bndrs -> - let (ctxt, tau) = splitLHsQualTy body in - if null invis_bndrs && null (unLoc ctxt) - then repLTy body - else do th_ctxt <- repLContext ctxt - th_tau <- repLTy tau - repTForall th_invis_bndrs th_ctxt th_tau - HsForAllVis{hsf_vis_bndrs = vis_bndrs } -> - addHsTyVarBinds vis_bndrs $ \ th_vis_bndrs -> do - th_body <- repLTy body - if null vis_bndrs - then pure th_body - else repTForallVis th_vis_bndrs th_body +repHsSigType' (HsSig { sig_bndrs = outer_bndrs, sig_body = body }) + | (ctxt, tau) <- splitLHsQualTy body + = addHsOuterSigTyVarBinds outer_bndrs $ \ th_outer_bndrs -> + do { th_ctxt <- repLContext ctxt + ; th_tau <- repLTy tau + ; if nullOuterExplicit outer_bndrs && null (unLoc ctxt) + then pure th_tau + else repTForall th_outer_bndrs th_ctxt th_tau } -- yield the representation of a list of types repLTys :: [LHsType GhcRn] -> MetaM [Core (M TH.Type)] @@ -2509,8 +2559,8 @@ repDerivStrategy mds thing_inside = StockStrategy -> thing_inside =<< just =<< repStockStrategy AnyclassStrategy -> thing_inside =<< just =<< repAnyclassStrategy NewtypeStrategy -> thing_inside =<< just =<< repNewtypeStrategy - ViaStrategy ty -> addSimpleTyVarBinds (get_scoped_tvs_from_sig ty) $ - do ty' <- rep_ty_sig' ty + ViaStrategy ty -> addSimpleTyVarBinds (get_scoped_tvs_from_sig' ty) $ + do ty' <- rep_ty_sig'_ ty via_strat <- repViaStrategy ty' m_via_strat <- just via_strat thing_inside m_via_strat ===================================== compiler/GHC/Iface/Ext/Ast.hs ===================================== @@ -1128,7 +1128,8 @@ instance HiePass p => ToHie (Located (HsExpr (GhcPass p))) where ] ExprWithTySig _ expr sig -> [ toHie expr - , toHie $ TS (ResolvedScopes [mkLScope expr]) sig + -- TODO RGS: Figure out how to do this correctly + -- , toHie $ TS (ResolvedScopes [mkLScope expr]) sig ] ArithSeq _ _ info -> [ toHie info @@ -1522,7 +1523,10 @@ instance ToHie (Located (DerivStrategy GhcRn)) where StockStrategy -> [] AnyclassStrategy -> [] NewtypeStrategy -> [] - ViaStrategy s -> [ toHie $ TS (ResolvedScopes []) s ] + ViaStrategy s -> [ {- + TODO RGS: Figure out how to do this properly + + toHie $ TS (ResolvedScopes []) s -} ] instance ToHie (Located OverlapMode) where toHie (L span _) = locOnly span @@ -1611,17 +1615,20 @@ instance HiePass p => ToHie (SigContext (Located (Sig (GhcPass p)))) where HieRn -> concatM $ makeNode sig sp : case sig of TypeSig _ names typ -> [ toHie $ map (C TyDecl) names - , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ + -- TODO RGS: Figure out how to do this correctly + -- , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ ] PatSynSig _ names typ -> [ toHie $ map (C TyDecl) names - , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ + -- TODO RGS: Figure out how to do this correctly + -- , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ ] ClassOpSig _ _ names typ -> [ case styp of ClassSig -> toHie $ map (C $ ClassTyDecl $ getRealSpan sp) names _ -> toHie $ map (C $ TyDecl) names - , toHie $ TS (UnresolvedScope (map unLoc names) msp) typ + -- TODO RGS: Figure out how to do this correctly + -- , toHie $ TS (UnresolvedScope (map unLoc names) msp) typ ] IdSig _ _ -> [] FixSig _ fsig -> @@ -1865,8 +1872,11 @@ instance ToHie (Located (InstDecl GhcRn)) where instance ToHie (Located (ClsInstDecl GhcRn)) where toHie (L span decl) = concatM - [ toHie $ TS (ResolvedScopes [mkScope span]) $ cid_poly_ty decl - , toHie $ fmap (BC InstanceBind ModuleScope) $ cid_binds decl + [ {- + TODO RGS: Figure out what to do here + + toHie $ TS (ResolvedScopes [mkScope span]) $ cid_poly_ty decl + , -} toHie $ fmap (BC InstanceBind ModuleScope) $ cid_binds decl , toHie $ map (SC $ SI InstSig $ getRealSpan span) $ cid_sigs decl , concatMapM (locOnly . getLoc) $ cid_tyfam_insts decl , toHie $ cid_tyfam_insts decl @@ -1891,8 +1901,11 @@ instance ToHie (Context a) instance ToHie (Located (DerivDecl GhcRn)) where toHie (L span decl) = concatM $ makeNode decl span : case decl of DerivDecl _ typ strat overlap -> - [ toHie $ TS (ResolvedScopes []) typ - , toHie strat + [ {- + TODO RGS: Figure out what to do here + + toHie $ TS (ResolvedScopes []) typ + , -} toHie strat , toHie overlap ] ===================================== compiler/GHC/Parser.y ===================================== @@ -1158,7 +1158,7 @@ sks_vars :: { Located [Located RdrName] } -- Returned in reverse order | oqtycon { sL1 $1 [$1] } inst_decl :: { LInstDecl GhcPs } - : 'instance' overlap_pragma inst_type where_inst + : 'instance' overlap_pragma inst_type2 where_inst {% do { (binds, sigs, _, ats, adts, _) <- cvBindsAndSigs (snd $ unLoc $4) ; let cid = ClsInstDecl { cid_ext = noExtField , cid_poly_ty = $3, cid_binds = binds @@ -1166,7 +1166,7 @@ inst_decl :: { LInstDecl GhcPs } , cid_tyfam_insts = ats , cid_overlap_mode = $2 , cid_datafam_insts = adts } - ; ams (L (comb3 $1 (hsSigType $3) $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid })) + ; ams (L (comb3 $1 $3 $4) (ClsInstD { cid_d_ext = noExtField, cid_inst = cid })) (mj AnnInstance $1 : (fst $ unLoc $4)) } } -- type instance declarations @@ -1213,7 +1213,7 @@ deriv_strategy_no_via :: { LDerivStrategy GhcPs } [mj AnnNewtype $1] } deriv_strategy_via :: { LDerivStrategy GhcPs } - : 'via' ktype {% ams (sLL $1 $> (ViaStrategy (mkLHsSigType $2))) + : 'via' sigktype2 {% ams (sLL $1 $> (ViaStrategy $2)) [mj AnnVia $1] } deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) } @@ -1441,10 +1441,10 @@ capi_ctype : '{-# CTYPE' STRING STRING '#-}' -- Glasgow extension: stand-alone deriving declarations stand_alone_deriving :: { LDerivDecl GhcPs } - : 'deriving' deriv_standalone_strategy 'instance' overlap_pragma inst_type + : 'deriving' deriv_standalone_strategy 'instance' overlap_pragma inst_type2 {% do { let { err = text "in the stand-alone deriving instance" <> colon <+> quotes (ppr $5) } - ; ams (sLL $1 (hsSigType $>) + ; ams (sLL $1 $> (DerivDecl noExtField (mkHsWildCardBndrs $5) $2 $4)) [mj AnnDeriving $1, mj AnnInstance $3] } } @@ -1516,8 +1516,8 @@ where_decls :: { Located ([AddAnn] ,sL1 $3 (snd $ unLoc $3)) } pattern_synonym_sig :: { LSig GhcPs } - : 'pattern' con_list '::' sigtype - {% ams (sLL $1 $> $ PatSynSig noExtField (unLoc $2) (mkLHsSigType $4)) + : 'pattern' con_list '::' sigtype2 + {% ams (sLL $1 $> $ PatSynSig noExtField (unLoc $2) $4) [mj AnnPattern $1, mu AnnDcolon $3] } ----------------------------------------------------------------------------- @@ -1530,12 +1530,12 @@ decl_cls : at_decl_cls { $1 } | decl { $1 } -- A 'default' signature used with the generic-programming extension - | 'default' infixexp '::' sigtype + | 'default' infixexp '::' sigtype2 {% runPV (unECP $2) >>= \ $2 -> do { v <- checkValSigLhs $2 ; let err = text "in default signature" <> colon <+> quotes (ppr $2) - ; ams (sLL $1 $> $ SigD noExtField $ ClassOpSig noExtField True [v] $ mkLHsSigType $4) + ; ams (sLL $1 $> $ SigD noExtField $ ClassOpSig noExtField True [v] $4) [mj AnnDefault $1,mu AnnDcolon $3] } } decls_cls :: { Located ([AddAnn],OrdList (LHsDecl GhcPs)) } -- Reversed @@ -1885,21 +1885,8 @@ sigktype2 :: { LHsSigType' GhcPs } -- TODO RGS: Docs -- TODO RGS: This is the REAL sigtype production. Delete the one above (and rename this) when ready sigtype2 :: { LHsSigType' GhcPs } - : forall_telescope ctype {% let (forall_tok, forall_anns, forall_tele) = unLoc $1 in - hintExplicitForall LangExt.ScopedTypeVariables forall_tok - >> ams (sLL $1 $> $ - mkHsExplicitSigType forall_tele $2) - forall_anns } - | context '=>' ctype {% do { addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2) - ; return $ - sLL $1 $> $ mkHsImplicitSigType $ - sLL $1 $> $ HsQualTy { hst_ctxt = $1 - , hst_xqual = noExtField - , hst_body = $3 }}} - | ipvar '::' type {% ams (sLL $1 $> $ mkHsImplicitSigType $ - sLL $1 $> $ HsIParamTy noExtField $1 $3) - [mu AnnDcolon $2] } - | type { sL1 $1 $ mkHsImplicitSigType $1 } + : ctype_w_ext {% do { ty <- $1 LangExt.ScopedTypeVariables + ; pure (hsTypeToHsSigType ty) }} sig_vars :: { Located [Located RdrName] } -- Returned in reversed order : sig_vars ',' var {% addAnnotation (gl $ head $ unLoc $1) @@ -1926,40 +1913,51 @@ unpackedness :: { Located UnpackednessPragma } : '{-# UNPACK' '#-}' { sLL $1 $> (UnpackednessPragma [mo $1, mc $2] (getUNPACK_PRAGs $1) SrcUnpack) } | '{-# NOUNPACK' '#-}' { sLL $1 $> (UnpackednessPragma [mo $1, mc $2] (getNOUNPACK_PRAGs $1) SrcNoUnpack) } -forall_telescope :: { Located (Located Token, [AddAnn], HsForAllTelescope GhcPs) } - : 'forall' tv_bndrs '.' { sLL $1 $> - ( $1 - , [mu AnnForall $1, mu AnnDot $3] - , mkHsForAllInvisTele $2 ) } - | 'forall' tv_bndrs '->' {% do { req_tvbs <- fromSpecTyVarBndrs $2 - ; pure $ sLL $1 $> $ - ( $1 - , [mu AnnForall $1, mu AnnRarrow $3] - , mkHsForAllVisTele req_tvbs ) }} +-- TODO RGS: Explain the Extension argument +forall_telescope :: { LangExt.Extension -> P (Located ([AddAnn], HsForAllTelescope GhcPs)) } + : 'forall' tv_bndrs '.' { \ext -> + do { hintExplicitForall ext $1 + ; pure $ sLL $1 $> + ( [mu AnnForall $1, mu AnnDot $3] + , mkHsForAllInvisTele $2 ) }} + | 'forall' tv_bndrs '->' { \_ -> + do { hintExplicitForall LangExt.RankNTypes $1 + ; req_tvbs <- fromSpecTyVarBndrs $2 + ; pure $ sLL $1 $> $ + ( [mu AnnForall $1, mu AnnRarrow $3] + , mkHsForAllVisTele req_tvbs ) }} -- A ktype is a ctype, possibly with a kind annotation ktype :: { LHsType GhcPs } : ctype { $1 } | ctype '::' kind {% ams (sLL $1 $> $ HsKindSig noExtField $1 $3) [mu AnnDcolon $2] } +-- A ctype is a for-all type +-- TODO RGS: More docs +ctype :: { LHsType GhcPs } + : ctype_w_ext {% $1 LangExt.RankNTypes } -- A ctype is a for-all type -ctype :: { LHsType GhcPs } - : forall_telescope ctype {% let (forall_tok, forall_anns, forall_tele) = unLoc $1 in - hintExplicitForall LangExt.RankNTypes forall_tok - >> ams (sLL $1 $> $ - HsForAllTy { hst_tele = forall_tele - , hst_xforall = noExtField - , hst_body = $2 }) - forall_anns } - | context '=>' ctype {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2) - >> return (sLL $1 $> $ - HsQualTy { hst_ctxt = $1 - , hst_xqual = noExtField - , hst_body = $3 }) } - | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExtField $1 $3)) - [mu AnnDcolon $2] } - | type { $1 } +-- TODO RGS: Explain the Extension argument. Revise the docs. +ctype_w_ext :: { LangExt.Extension -> P (LHsType GhcPs) } + : forall_telescope ctype { \ext -> + do { ltele <- $1 ext + ; let (forall_anns, forall_tele) = unLoc ltele + ; ams (sLL ltele $> $ + HsForAllTy { hst_tele = forall_tele + , hst_xforall = noExtField + , hst_body = $2 }) + forall_anns }} + | context '=>' ctype { \_ -> + addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2) + >> return (sLL $1 $> $ + HsQualTy { hst_ctxt = $1 + , hst_xqual = noExtField + , hst_body = $3 }) } + | ipvar '::' type { \_ -> + ams (sLL $1 $> (HsIParamTy noExtField $1 $3)) + [mu AnnDcolon $2] } + | type { \_ -> pure $1 } ---------------------- -- Notes for 'context' ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1599,6 +1599,7 @@ instance DisambECP (HsExpr GhcPs) where mkHsLitPV (L l a) = return $ L l (HsLit noExtField a) mkHsOverLitPV (L l a) = return $ L l (HsOverLit noExtField a) mkHsWildCardPV l = return $ L l hsHoleExpr + -- mkHsTySigPV l a sig = return $ L l (ExprWithTySig noExtField a (hsTypeToHsSigWcType sig)) mkHsTySigPV l a sig = return $ L l (ExprWithTySig noExtField a (mkLHsSigWcType sig)) mkHsExplicitListPV l xs = return $ L l (ExplicitList noExtField Nothing xs) mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExtField) sp ===================================== compiler/GHC/Parser/PostProcess/Haddock.hs ===================================== @@ -925,8 +925,8 @@ instance HasHaddock (Located (HsSigType GhcPs)) where -- HasHaddock instance for HsType. Is this right? Need Vlad to check. extendHdkA l $ do case outer_bndrs of - HsOuterImplicit{} -> pure () - HsOuterExplicit{hso_bndrs = tele} -> registerLocHdkA (getForAllTeleLoc tele) + HsOuterImplicit{} -> pure () + HsOuterExplicit{hso_bndrs = bndrs} -> registerLocHdkA (getLHsTyVarBndrsLoc bndrs) body' <- addHaddock body pure $ L l $ HsSig noExtField outer_bndrs body' @@ -1461,10 +1461,12 @@ mkLHsDocTy t (Just doc) = L (getLoc t) (HsDocTy noExtField t doc) getForAllTeleLoc :: HsForAllTelescope GhcPs -> SrcSpan getForAllTeleLoc tele = - foldr combineSrcSpans noSrcSpan $ case tele of - HsForAllVis{ hsf_vis_bndrs } -> map getLoc hsf_vis_bndrs - HsForAllInvis { hsf_invis_bndrs } -> map getLoc hsf_invis_bndrs + HsForAllVis{ hsf_vis_bndrs } -> getLHsTyVarBndrsLoc hsf_vis_bndrs + HsForAllInvis { hsf_invis_bndrs } -> getLHsTyVarBndrsLoc hsf_invis_bndrs + +getLHsTyVarBndrsLoc :: [LHsTyVarBndr flag GhcPs] -> SrcSpan +getLHsTyVarBndrsLoc bndrs = foldr combineSrcSpans noSrcSpan $ map getLoc bndrs -- | The inverse of 'partitionBindsAndSigs' that merges partitioned items back -- into a flat list. Elements are put back into the order in which they ===================================== compiler/GHC/Rename/Bind.hs ===================================== @@ -610,11 +610,11 @@ mkScopedTvFn sigs = \n -> lookupNameEnv env n `orElse` [] get_scoped_tvs :: LSig GhcRn -> Maybe ([Located Name], [Name]) -- Returns (binders, scoped tvs for those binders) get_scoped_tvs (L _ (ClassOpSig _ _ names sig_ty)) - = Just (names, hsScopedTvs sig_ty) + = Just (names, hsScopedTvs' sig_ty) get_scoped_tvs (L _ (TypeSig _ names sig_ty)) = Just (names, hsWcScopedTvs sig_ty) get_scoped_tvs (L _ (PatSynSig _ names sig_ty)) - = Just (names, hsScopedTvs sig_ty) + = Just (names, hsScopedTvs' sig_ty) get_scoped_tvs _ = Nothing -- Process the fixity declarations, making a FastString -> (Located Fixity) map @@ -965,7 +965,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty) ; when (is_deflt && not defaultSigs_on) $ addErr (defaultSigErr sig) ; new_v <- mapM (lookupSigOccRn ctxt sig) vs - ; (new_ty, fvs) <- rnHsSigType ty_ctxt TypeLevel ty + ; (new_ty, fvs) <- rnLHsSigType ty_ctxt TypeLevel ty ; return (ClassOpSig noExtField is_deflt new_v new_ty, fvs) } where (v1:_) = vs @@ -1017,7 +1017,7 @@ renameSig ctxt sig@(MinimalSig _ s (L l bf)) renameSig ctxt sig@(PatSynSig _ vs ty) = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs - ; (ty', fvs) <- rnHsSigType ty_ctxt TypeLevel ty + ; (ty', fvs) <- rnLHsSigType ty_ctxt TypeLevel ty ; return (PatSynSig noExtField new_vs ty', fvs) } where ty_ctxt = GenericCtx (text "a pattern synonym signature for" ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -13,7 +13,7 @@ module GHC.Rename.HsType ( rnHsType, rnLHsType, rnLHsTypes, rnContext, rnHsKind, rnLHsKind, rnLHsTypeArgs, rnHsSigType, rnLHsSigType, rnHsSigType', rnHsWcType, - HsSigWcTypeScoping(..), rnHsSigWcType, rnHsPatSigType, + HsSigWcTypeScoping(..), rnHsSigWcType, rnLHsSigWcType, rnHsPatSigType, newTyVarNameRn, rnConDeclFields, rnLTyVar, @@ -25,14 +25,13 @@ module GHC.Rename.HsType ( checkPrecMatch, checkSectionPrec, -- Binding related stuff - bindHsOuterFamEqnTyVarBndrs, bindHsOuterGadtTyVarBndrs, - bindHsForAllTelescope, + bindHsOuterTyVarBndrs, bindHsForAllTelescope, bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..), rnImplicitBndrs, bindSigTyVarsFV, bindHsQTyVars, FreeKiTyVars, extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars, extractHsTysRdrTyVars, extractRdrKindSigVars, extractDataDefnKindVars, - extractHsOuterGadtTvBndrs, extractHsTyArgRdrKiTyVars, + extractHsOuterTvBndrs, extractHsTyArgRdrKiTyVars, forAllOrNothing, nubL ) where @@ -133,6 +132,22 @@ rnHsSigWcType doc (HsWC { hswc_body = HsIB { hsib_body = hs_ty }}) wc_ty = HsWC { hswc_ext = nwcs, hswc_body = ib_ty } in pure (wc_ty, emptyFVs) +-- TODO RGS: This is the REAL rnHsSigWcType. Delete the one above when ready. +rnLHsSigWcType :: HsDocContext + -> LHsSigWcType' GhcPs + -> RnM (LHsSigWcType' GhcRn, FreeVars) +rnLHsSigWcType doc (HsWC { hswc_body = + sig_ty@(L loc (HsSig{sig_bndrs = outer_bndrs, sig_body = body_ty })) }) + = do { free_vars <- filterInScopeM (extract_lhs_sig_ty sig_ty) + ; (nwc_rdrs', imp_tv_nms) <- partition_nwcs free_vars + ; let nwc_rdrs = nubL nwc_rdrs' + ; bindHsOuterTyVarBndrs doc Nothing imp_tv_nms outer_bndrs $ \outer_bndrs' -> + do { (wcs, body_ty', fvs) <- rnWcBody doc nwc_rdrs body_ty + ; pure ( HsWC { hswc_ext = wcs, hswc_body = L loc $ + HsSig { sig_ext = noExtField + , sig_bndrs = outer_bndrs', sig_body = body_ty' }} + , fvs) } } + rnHsPatSigType :: HsSigWcTypeScoping -> HsDocContext -> HsPatSigType GhcPs @@ -354,7 +369,7 @@ rnHsSigType' ctx level sig_ty@(HsSig { sig_bndrs = outer_bndrs, sig_body = body }) = do { traceRn "rnHsSigType" (ppr sig_ty) ; imp_vars <- filterInScopeM $ extractHsTyRdrTyVars body - ; bindHsOuterSigTyVarBndrs ctx imp_vars outer_bndrs $ \outer_bndrs' -> + ; bindHsOuterTyVarBndrs ctx Nothing imp_vars outer_bndrs $ \outer_bndrs' -> do { (body', fvs) <- rnLHsTyKi (mkTyKiEnv ctx level RnTypeBody) body ; return ( HsSig { sig_ext = noExtField @@ -1071,14 +1086,15 @@ an LHsQTyVars can be semantically significant. As a result, we suppress -Wunused-foralls warnings in exactly one place: in bindHsQTyVars. -} -bindHsOuterFamEqnTyVarBndrs :: HsDocContext - -> Maybe assoc - -- ^ @'Just' _@ => an associated type decl - -> FreeKiTyVars - -> HsOuterFamEqnTyVarBndrs GhcPs - -> (HsOuterFamEqnTyVarBndrs GhcRn -> RnM (a, FreeVars)) - -> RnM (a, FreeVars) -bindHsOuterFamEqnTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = +bindHsOuterTyVarBndrs :: OutputableBndrFlag flag + => HsDocContext + -> Maybe assoc + -- ^ @'Just' _@ => an associated type decl + -> FreeKiTyVars + -> HsOuterTyVarBndrs flag GhcPs + -> (HsOuterTyVarBndrs flag GhcRn -> RnM (a, FreeVars)) + -> RnM (a, FreeVars) +bindHsOuterTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = case outer_bndrs of HsOuterImplicit{} -> rnImplicitBndrs mb_cls implicit_vars $ \implicit_vars' -> @@ -1092,36 +1108,6 @@ bindHsOuterFamEqnTyVarBndrs doc mb_cls implicit_vars outer_bndrs thing_inside = thing_inside $ HsOuterExplicit{ hso_xexplicit = noExtField , hso_bndrs = exp_bndrs' } -bindHsOuterGadtTyVarBndrs :: HsDocContext - -> FreeKiTyVars - -> HsOuterGadtTyVarBndrs GhcPs - -> (HsOuterGadtTyVarBndrs GhcRn -> RnM (a, FreeVars)) - -> RnM (a, FreeVars) -bindHsOuterGadtTyVarBndrs doc implicit_vars outer_bndrs thing_inside = - case outer_bndrs of - HsOuterImplicit{} -> - rnImplicitBndrs Nothing implicit_vars $ \implicit_vars' -> - thing_inside $ HsOuterImplicit{ hso_ximplicit = implicit_vars' } - HsOuterExplicit{hso_bndrs = exp_bndrs} -> - bindLHsTyVarBndrs doc WarnUnusedForalls Nothing exp_bndrs $ \exp_bndrs' -> - thing_inside $ HsOuterExplicit{ hso_xexplicit = noExtField - , hso_bndrs = exp_bndrs' } - -bindHsOuterSigTyVarBndrs :: HsDocContext - -> FreeKiTyVars - -> HsOuterSigTyVarBndrs GhcPs - -> (HsOuterSigTyVarBndrs GhcRn -> RnM (a, FreeVars)) - -> RnM (a, FreeVars) -bindHsOuterSigTyVarBndrs doc implicit_vars outer_bndrs thing_inside = - case outer_bndrs of - HsOuterImplicit{} -> - rnImplicitBndrs Nothing implicit_vars $ \implicit_vars' -> - thing_inside $ HsOuterImplicit{ hso_ximplicit = implicit_vars' } - HsOuterExplicit{hso_bndrs = tele} -> - bindHsForAllTelescope doc tele $ \tele' -> - thing_inside $ HsOuterExplicit{ hso_xexplicit = noExtField - , hso_bndrs = tele' } - bindHsForAllTelescope :: HsDocContext -> HsForAllTelescope GhcPs -> (HsForAllTelescope GhcRn -> RnM (a, FreeVars)) @@ -1917,6 +1903,10 @@ extract_lty (L _ ty) acc -- We deal with these separately in rnLHsTypeWithWildCards HsWildCardTy {} -> acc +extract_lhs_sig_ty :: LHsSigType' GhcPs -> FreeKiTyVars +extract_lhs_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) = + extractHsOuterTvBndrs outer_bndrs $ extract_lty body [] + extract_hs_arrow :: HsArrow GhcPs -> FreeKiTyVars -> FreeKiTyVars extract_hs_arrow (HsExplicitMult p) acc = extract_lty p acc @@ -1933,10 +1923,10 @@ extract_hs_for_all_telescope tele acc_vars body_fvs = HsForAllInvis { hsf_invis_bndrs = bndrs } -> extract_hs_tv_bndrs bndrs acc_vars body_fvs -extractHsOuterGadtTvBndrs :: HsOuterGadtTyVarBndrs GhcPs - -> FreeKiTyVars -- Free in body - -> FreeKiTyVars -- Free in result -extractHsOuterGadtTvBndrs outer_bndrs body_fvs = +extractHsOuterTvBndrs :: HsOuterTyVarBndrs flag GhcPs + -> FreeKiTyVars -- Free in body + -> FreeKiTyVars -- Free in result +extractHsOuterTvBndrs outer_bndrs body_fvs = case outer_bndrs of HsOuterImplicit{} -> body_fvs ===================================== compiler/GHC/Rename/Module.hs ===================================== @@ -35,7 +35,7 @@ import GHC.Rename.Utils ( HsDocContext(..), mapFvRn, bindLocalNames , checkShadowedRdrNames, warnUnusedTypePatterns , extendTyVarEnvFVRn, newLocalBndrsRn , withHsDocContext, noNestedForallsContextsErr - , addNoNestedForallsContextsErr, checkInferredVars ) + , addNoNestedForallsContextsErr, checkInferredVars, checkInferredVars' ) import GHC.Rename.Unbound ( mkUnboundName, notInScopeErr ) import GHC.Rename.Names import GHC.Rename.Doc ( rnHsDoc, rnMbLHsDoc ) @@ -450,7 +450,7 @@ rnSrcInstDecl (ClsInstD { cid_inst = cid }) -- -- See also descriptions of 'checkCanonicalMonadInstances' and -- 'checkCanonicalMonoidInstances' -checkCanonicalInstances :: Name -> LHsSigType GhcRn -> LHsBinds GhcRn -> RnM () +checkCanonicalInstances :: Name -> LHsSigType' GhcRn -> LHsBinds GhcRn -> RnM () checkCanonicalInstances cls poly_ty mbinds = do whenWOptM Opt_WarnNonCanonicalMonadInstances checkCanonicalMonadInstances @@ -589,9 +589,9 @@ checkCanonicalInstances cls poly_ty mbinds = do ] -- stolen from GHC.Tc.TyCl.Instance - instDeclCtxt1 :: LHsSigType GhcRn -> SDoc + instDeclCtxt1 :: LHsSigType' GhcRn -> SDoc instDeclCtxt1 hs_inst_ty - = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) + = inst_decl_ctxt (ppr (getLHsInstDeclHead' hs_inst_ty)) inst_decl_ctxt :: SDoc -> SDoc inst_decl_ctxt doc = hang (text "in the instance declaration for") @@ -603,9 +603,9 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds , cid_sigs = uprags, cid_tyfam_insts = ats , cid_overlap_mode = oflag , cid_datafam_insts = adts }) - = do { checkInferredVars ctxt inf_err inst_ty - ; (inst_ty', inst_fvs) <- rnHsSigType ctxt TypeLevel inst_ty - ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy inst_ty' + = do { checkInferredVars' ctxt inf_err inst_ty + ; (inst_ty', inst_fvs) <- rnLHsSigType ctxt TypeLevel inst_ty + ; let (ktv_names, _, head_ty') = splitLHsInstDeclTy' inst_ty' -- Check if there are any nested `forall`s or contexts, which are -- illegal in the type of an instance declaration (see -- Note [No nested foralls or contexts in instance types] in @@ -724,15 +724,7 @@ rnFamEqn doc atfi rhs_kvars -- @ ; let all_imp_vars = pat_kity_vars_with_dups ++ rhs_kvars - {- - TODO RGS: Delete - - ; rnImplicitBndrs mb_cls all_imp_vars $ \all_imp_var_names' -> - bindLHsTyVarBndrs doc WarnUnusedForalls - Nothing (fromMaybe [] mb_bndrs) $ \bndrs' -> - -} - ; bindHsOuterFamEqnTyVarBndrs doc mb_cls all_imp_vars - outer_bndrs $ \rn_outer_bndrs -> + ; bindHsOuterTyVarBndrs doc mb_cls all_imp_vars outer_bndrs $ \rn_outer_bndrs -> do { (pats', pat_fvs) <- rnLHsTypeArgs (FamPatCtx tycon) pats ; (payload', rhs_fvs) <- rn_payload doc payload @@ -1075,22 +1067,22 @@ rnSrcDerivDecl :: DerivDecl GhcPs -> RnM (DerivDecl GhcRn, FreeVars) rnSrcDerivDecl (DerivDecl _ ty mds overlap) = do { standalone_deriv_ok <- xoptM LangExt.StandaloneDeriving ; unless standalone_deriv_ok (addErr standaloneDerivErr) - ; checkInferredVars ctxt inf_err nowc_ty - ; (mds', ty', fvs) <- rnLDerivStrategy ctxt mds $ rnHsSigWcType ctxt ty + ; checkInferredVars' ctxt inf_err nowc_ty + ; (mds', ty', fvs) <- rnLDerivStrategy ctxt mds $ rnLHsSigWcType ctxt ty -- Check if there are any nested `forall`s or contexts, which are -- illegal in the type of an instance declaration (see -- Note [No nested foralls or contexts in instance types] in -- GHC.Hs.Type). ; addNoNestedForallsContextsErr ctxt (text "Standalone-derived instance head") - (getLHsInstDeclHead $ dropWildCards ty') + (getLHsInstDeclHead' $ dropWildCards' ty') ; warnNoDerivStrat mds' loc ; return (DerivDecl noExtField ty' mds' overlap, fvs) } where ctxt = DerivDeclCtx inf_err = Just (text "Inferred type variables are not allowed") - loc = getLoc $ hsib_body nowc_ty - nowc_ty = dropWildCards ty + loc = getLoc nowc_ty + nowc_ty = dropWildCards' ty standaloneDerivErr :: SDoc standaloneDerivErr @@ -1946,19 +1938,22 @@ rnLDerivStrategy doc mds thing_inside AnyclassStrategy -> boring_case AnyclassStrategy NewtypeStrategy -> boring_case NewtypeStrategy ViaStrategy via_ty -> - do checkInferredVars doc inf_err via_ty - (via_ty', fvs1) <- rnHsSigType doc TypeLevel via_ty - let HsIB { hsib_ext = via_imp_tvs - , hsib_body = via_body } = via_ty' - (via_exp_tv_bndrs, via_rho) = splitLHsForAllTyInvis_KP via_body - via_exp_tvs = maybe [] hsLTyVarNames via_exp_tv_bndrs - via_tvs = via_imp_tvs ++ via_exp_tvs + do checkInferredVars' doc inf_err via_ty + (via_ty', fvs1) <- rnLHsSigType doc TypeLevel via_ty + let HsSig { sig_bndrs = via_outer_bndrs + , sig_body = via_body } = unLoc via_ty' + -- TODO RGS: We also do something like this in splitLHsInstDeclTy. + -- Consider factoring this out into its own function in the same + -- vein as hsScopedTvs. + via_tvs = case via_outer_bndrs of + HsOuterImplicit{hso_ximplicit = imp_tvs} -> imp_tvs + HsOuterExplicit{hso_bndrs = exp_bndrs} -> hsLTyVarNames exp_bndrs -- Check if there are any nested `forall`s, which are illegal in a -- `via` type. -- See Note [No nested foralls or contexts in instance types] -- (Wrinkle: Derived instances) in GHC.Hs.Type. addNoNestedForallsContextsErr doc - (quotes (text "via") <+> text "type") via_rho + (quotes (text "via") <+> text "type") via_body (thing, fvs2) <- extendTyVarEnvFVRn via_tvs thing_inside pure (ViaStrategy via_ty', thing, fvs1 `plusFV` fvs2) @@ -2231,12 +2226,12 @@ rnConDecl (ConDeclGADT { con_names = names -- variable, and hence the order needed for visible type application -- See #14808. implicit_bndrs = - extractHsOuterGadtTvBndrs outer_bndrs $ + extractHsOuterTvBndrs outer_bndrs $ extractHsTysRdrTyVars (theta ++ map hsScaledThing arg_tys ++ [res_ty]) ; let ctxt = ConDeclCtx new_names - ; bindHsOuterGadtTyVarBndrs ctxt implicit_bndrs outer_bndrs $ \outer_bndrs' -> + ; bindHsOuterTyVarBndrs ctxt Nothing implicit_bndrs outer_bndrs $ \outer_bndrs' -> do { (new_cxt, fvs1) <- rnMbContext ctxt mcxt ; (new_args, fvs2) <- rnConDeclDetails (unLoc (head new_names)) ctxt args ; (new_res_ty, fvs3) <- rnLHsType ctxt res_ty ===================================== compiler/GHC/Rename/Names.hs ===================================== @@ -800,7 +800,7 @@ getLocalNonValBinders fixity_env -- be Nothing. mb_cls_nm <- runMaybeT $ do -- See (1) above - L loc cls_rdr <- MaybeT $ pure $ getLHsInstDeclClass_maybe inst_ty + L loc cls_rdr <- MaybeT $ pure $ getLHsInstDeclClass_maybe' inst_ty -- See (2) above MaybeT $ setSrcSpan loc $ lookupGlobalOccRn_maybe cls_rdr -- Assuming the previous step succeeded, process any associated data ===================================== compiler/GHC/Rename/Utils.hs ===================================== @@ -223,13 +223,8 @@ checkInferredVars' ctxt (Just msg) ty = where sig_exp_bndrs :: LHsSigType' GhcPs -> [HsTyVarBndr Specificity GhcPs] sig_exp_bndrs (L _ (HsSig{sig_bndrs = outer_bndrs})) = case outer_bndrs of - HsOuterImplicit{} - -> [] - HsOuterExplicit{hso_bndrs = exp_bndrs} -> case exp_bndrs of - HsForAllInvis{hsf_invis_bndrs = invis_bndrs} - -> map unLoc invis_bndrs - HsForAllVis{} - -> [] + HsOuterImplicit{} -> [] + HsOuterExplicit{hso_bndrs = exp_bndrs} -> map unLoc exp_bndrs {- Note [Unobservably inferred type variables] ===================================== compiler/GHC/Tc/Deriv.hs ===================================== @@ -628,7 +628,7 @@ deriveStandalone (L loc (DerivDecl _ deriv_ty mb_lderiv_strat overlap_mode)) ; (mb_lderiv_strat, via_tvs) <- tcDerivStrategy mb_lderiv_strat ; (cls_tvs, deriv_ctxt, cls, inst_tys) <- tcExtendTyVarEnv via_tvs $ - tcStandaloneDerivInstType ctxt deriv_ty + tcStandaloneDerivInstType' ctxt deriv_ty ; let mb_deriv_strat = fmap unLoc mb_lderiv_strat tvs = via_tvs ++ cls_tvs -- See Note [Unify kinds in deriving] @@ -733,6 +733,27 @@ tcStandaloneDerivInstType ctxt let (tvs, theta, cls, inst_tys) = tcSplitDFunTy dfun_ty pure (tvs, SupplyContext theta, cls, inst_tys) +-- TODO RGS: This is the REAL tcStandaloneDerivInstType. Delete the one above when ready. +tcStandaloneDerivInstType' + :: UserTypeCtxt -> LHsSigWcType' GhcRn + -> TcM ([TyVar], DerivContext, Class, [Type]) +tcStandaloneDerivInstType' ctxt + (HsWC { hswc_body = deriv_ty@(L loc (HsSig { sig_bndrs = outer_bndrs + , sig_body = deriv_ty_body }))}) + | (theta, rho) <- splitLHsQualTy deriv_ty_body + , L _ [wc_pred] <- theta + , L wc_span (HsWildCardTy _) <- ignoreParens wc_pred + = do dfun_ty <- tcHsClsInstType' ctxt $ L loc $ + HsSig { sig_ext = noExtField + , sig_bndrs = outer_bndrs + , sig_body = rho } + let (tvs, _theta, cls, inst_tys) = tcSplitDFunTy dfun_ty + pure (tvs, InferContext (Just wc_span), cls, inst_tys) + | otherwise + = do dfun_ty <- tcHsClsInstType' ctxt deriv_ty + let (tvs, theta, cls, inst_tys) = tcSplitDFunTy dfun_ty + pure (tvs, SupplyContext theta, cls, inst_tys) + warnUselessTypeable :: TcM () warnUselessTypeable = do { warn <- woptM Opt_WarnDerivingTypeable @@ -2296,6 +2317,6 @@ derivingHiddenErr tc = hang (text "The data constructors of" <+> quotes (ppr tc) <+> ptext (sLit "are not all in scope")) 2 (text "so you cannot derive an instance for it") -standaloneCtxt :: LHsSigWcType GhcRn -> SDoc +standaloneCtxt :: LHsSigWcType' GhcRn -> SDoc standaloneCtxt ty = hang (text "In the stand-alone deriving instance for") 2 (quotes (ppr ty)) ===================================== compiler/GHC/Tc/Deriv/Generate.hs ===================================== @@ -1894,7 +1894,7 @@ gen_Newtype_binds loc cls inst_tvs inst_tys rhs_ty -- -- op :: forall c. a -> [T x] -> c -> Int L loc $ ClassOpSig noExtField False [loc_meth_RDR] - $ mkLHsSigType $ nlHsCoreTy to_ty + $ L loc $ mkHsImplicitSigType $ nlHsCoreTy to_ty ) where Pair from_ty to_ty = mkCoerceClassMethEqn cls inst_tvs inst_tys rhs_ty meth_id @@ -1955,6 +1955,7 @@ nlHsAppType e s = noLoc (HsAppType noExtField e hs_ty) nlExprWithTySig :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs nlExprWithTySig e s = noLoc $ ExprWithTySig noExtField (parenthesizeHsExpr sigPrec e) hs_ty where + -- hs_ty = hsTypeToHsSigWcType s hs_ty = mkLHsSigWcType s nlHsCoreTy :: Type -> LHsType GhcPs @@ -2002,8 +2003,6 @@ The `tags' here start at zero, hence the @fIRST_TAG@ (currently one) fiddling around. -} --- | Generate the full code for an auxiliary binding. --- See @Note [Auxiliary binders] (Wrinkle: Reducing code duplication)@. genAuxBindSpecOriginal :: DynFlags -> SrcSpan -> AuxBindSpec -> (LHsBind GhcPs, LSig GhcPs) genAuxBindSpecOriginal dflags loc spec @@ -2081,8 +2080,8 @@ genAuxBindSpecDup loc original_rdr_name dup_spec where dup_rdr_name = auxBindSpecRdrName dup_spec --- | Generate the type signature of an auxiliary binding. --- See @Note [Auxiliary binders]@. +-- | Generate the full code for an auxiliary binding. +-- See @Note [Auxiliary binders] (Wrinkle: Reducing code duplication)@. genAuxBindSpecSig :: SrcSpan -> AuxBindSpec -> LHsSigWcType GhcPs genAuxBindSpecSig loc spec = case spec of DerivCon2Tag tycon _ @@ -2100,6 +2099,26 @@ genAuxBindSpecSig loc spec = case spec of DerivDataConstr _ _ _ -> mkLHsSigWcType (nlHsTyVar constr_RDR) +-- TODO RGS: This is the REAL genAuxBindSpecSig. Delete the one above when ready. +genAuxBindSpecSig' :: SrcSpan -> AuxBindSpec -> LHsSigWcType' GhcPs +genAuxBindSpecSig' loc spec = case spec of + DerivCon2Tag tycon _ + -> mk_sig $ L loc $ XHsType $ NHsCoreTy $ + mkSpecSigmaTy (tyConTyVars tycon) (tyConStupidTheta tycon) $ + mkParentType tycon `mkVisFunTyMany` intPrimTy + DerivTag2Con tycon _ + -> mk_sig $ L loc $ + XHsType $ NHsCoreTy $ mkSpecForAllTys (tyConTyVars tycon) $ + intTy `mkVisFunTyMany` mkParentType tycon + DerivMaxTag _ _ + -> mk_sig (L loc (XHsType (NHsCoreTy intTy))) + DerivDataDataType _ _ _ + -> mk_sig (nlHsTyVar dataType_RDR) + DerivDataConstr _ _ _ + -> mk_sig (nlHsTyVar constr_RDR) + where + mk_sig = mkHsWildCardBndrs . L loc . mkHsImplicitSigType + type SeparateBagsDerivStuff = -- DerivAuxBinds ( Bag (LHsBind GhcPs, LSig GhcPs) ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -1749,6 +1749,7 @@ decideGeneralisationPlan dflags lbinds closed sig_fn | TcIdSig (PartialSig { psig_hs_ty = hs_ty }) <- mapMaybe sig_fn (collectHsBindListBinders lbinds) , let (_, L _ theta, _) = splitLHsSigmaTyInvis (hsSigWcType hs_ty) ] + -- , let (L _ theta, _) = splitLHsQualTy (hsSigWcTypeBody hs_ty) ] has_partial_sigs = not (null partial_sig_mrs) ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -16,8 +16,8 @@ module GHC.Tc.Gen.HsType ( -- Type signatures kcClassSigType, tcClassSigType, - tcHsSigType, tcLHsSigType, tcHsSigWcType, - tcHsPartialSigType, + tcHsSigType, tcLHsSigType, tcHsSigWcType, tcLHsSigWcType, + tcHsPartialSigType, tcHsPartialSigType', tcStandaloneKindSig, funsSigCtxt, addSigCtxt, pprSigCtxt, @@ -30,7 +30,7 @@ module GHC.Tc.Gen.HsType ( bindExplicitTKBndrs_Tv, bindExplicitTKBndrs_Skol, bindExplicitTKBndrs_Q_Tv, bindExplicitTKBndrs_Q_Skol, bindOuterFamEqnTKBndrs_Q_Skol, bindOuterFamEqnTKBndrs_Q_Tv, - bindOuterGadtTKBndrs_Tv, bindOuterGadtTKBndrs_Skol, + bindOuterSigTKBndrs_Tv, bindOuterSigTKBndrs_Skol, ContextKind(..), -- Type checking type and class decls, and instances thereof @@ -291,7 +291,14 @@ tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type -- already checked this, so we can simply ignore it. tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty) -kcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM () +-- TODO RGS: This is the REAL tcHsSigWcType. Delete the one above when ready. +tcLHsSigWcType :: UserTypeCtxt -> LHsSigWcType' GhcRn -> TcM Type +-- This one is used when we have a LHsSigWcType, but in +-- a place where wildcards aren't allowed. The renamer has +-- already checked this, so we can simply ignore it. +tcLHsSigWcType ctxt sig_ty = tcLHsSigType ctxt (dropWildCards' sig_ty) + +kcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType' GhcRn -> TcM () -- This is a special form of tcClassSigType that is used during the -- kind-checking phase to infer the kind of class variables. Cf. tc_hs_sig_type. -- Importantly, this does *not* kind-generalize. Consider @@ -304,22 +311,23 @@ kcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM () -- end up promoting kappa to the top level (because kind-generalization is -- normally done right before adding a binding to the context), and then we -- can't set kappa := f a, because a is local. -kcClassSigType skol_info names (HsIB { hsib_ext = sig_vars - , hsib_body = hs_ty }) - = addSigCtxt (funsSigCtxt names) hs_ty $ - do { (tc_lvl, (wanted, (spec_tkvs, _))) +kcClassSigType skol_info names + sig_ty@(L _ (HsSig { sig_bndrs = outer_bndrs, sig_body = hs_ty })) + = addSigCtxt (funsSigCtxt names) sig_ty $ + do { (tc_lvl, (wanted, (imp_or_exp_tkvs, _))) <- pushTcLevelM $ solveLocalEqualitiesX "kcClassSigType" $ - bindImplicitTKBndrs_Skol sig_vars $ + bindOuterSigTKBndrs_Skol outer_bndrs $ tcLHsType hs_ty liftedTypeKind + ; let spec_tkvs = either id binderVars imp_or_exp_tkvs ; emitResidualTvConstraint skol_info spec_tkvs tc_lvl wanted } -tcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType GhcRn -> TcM Type +tcClassSigType :: SkolemInfo -> [Located Name] -> LHsSigType' GhcRn -> TcM Type -- Does not do validity checking tcClassSigType skol_info names sig_ty - = addSigCtxt (funsSigCtxt names) (hsSigType sig_ty) $ - do { (implic, ty) <- tc_hs_sig_type skol_info sig_ty (TheKind liftedTypeKind) + = addSigCtxt (funsSigCtxt names) sig_ty $ + do { (implic, ty) <- tc_hs_sig_type' skol_info sig_ty (TheKind liftedTypeKind) ; emitImplication implic ; return ty } -- Do not zonk-to-Type, nor perform a validity check @@ -445,7 +453,7 @@ tc_hs_sig_type' skol_info (L loc (HsSig { sig_bndrs = outer_bndrs -- should be in the global tyvars, and therefore won't be quantified ; imp_or_exp_tkvs <- bitraverse zonkAndScopedSort pure imp_or_exp_tkvs - ; let ty1 = either mkSpecForAllTys mkForAllTys imp_or_exp_tkvs ty + ; let ty1 = either mkSpecForAllTys mkInvisForAllTys imp_or_exp_tkvs ty -- This bit is very much like decideMonoTyVars in GHC.Tc.Solver, -- but constraints are so much simpler in kinds, it is much @@ -562,7 +570,7 @@ tc_top_lhs_sig_type mode (L loc sig_ty@(HsSig { sig_bndrs = outer_bndrs ; tc_lhs_type mode body kind } ; imp_or_exp_tkvs <- bitraverse zonkAndScopedSort pure imp_or_exp_tkvs - ; let ty1 = either mkSpecForAllTys mkForAllTys imp_or_exp_tkvs ty + ; let ty1 = either mkSpecForAllTys mkInvisForAllTys imp_or_exp_tkvs ty ; kvs <- kindGeneralizeAll ty1 -- "All" because it's a top-level type ; final_ty <- zonkTcTypeToType (mkInfForAllTys kvs ty1) ; traceTc "tc_top_hs_sig_type }" (vcat [ppr sig_ty, ppr final_ty]) @@ -608,7 +616,7 @@ tcDerivStrategy mb_lds tc_deriv_strategy AnyclassStrategy = boring_case AnyclassStrategy tc_deriv_strategy NewtypeStrategy = boring_case NewtypeStrategy tc_deriv_strategy (ViaStrategy ty) = do - ty' <- checkNoErrs $ tcTopLHsType ty AnyKind + ty' <- checkNoErrs $ tcTopLHsSigType ty AnyKind let (via_tvs, via_pred) = splitForAllTys ty' pure (ViaStrategy via_pred, via_tvs) @@ -3070,8 +3078,9 @@ cloneFlexiKindedTyVarTyVar = newFlexiKindedTyVar cloneTyVarTyVar -- TODO RGS: Which of these do we actually need? +{- -- | Skolemise the 'HsTyVarBndr's in an 'HsForAllTelescope'. --- TODO RGS: Consolidate with bindExplicitTK_Tele_Tv? +-- TODO RGS: Consolidate with bindExplicitTK_Skol_M? bindExplicitTKTele_Skol :: HsForAllTelescope GhcRn -> TcM a @@ -3087,27 +3096,8 @@ bindExplicitTKTele_Skol tele thing_inside = case tele of -- inv_tv_bndrs :: [VarBndr TyVar Specificity], -- but we want [VarBndr TyVar ArgFlag] ; return (tyVarSpecToBinders inv_tv_bndrs, thing) } - -{- --- | Clone the 'HsTyVarBndr's in an 'HsForAllTelescope'. --- TODO RGS: Consolidate with bindExplicitTK_Tele_Skol? -bindExplicitTKTele_Tv - :: HsForAllTelescope GhcRn - -> TcM a - -> TcM (Either [TcReqTVBinder] [TcInvisTVBinder], a) -bindExplicitTKTele_Tv tele thing_inside = case tele of - HsForAllVis { hsf_vis_bndrs = bndrs } -> do - (req_tv_bndrs, thing) <- bindExplicitTKBndrs_Tv bndrs thing_inside - pure (Left req_tv_bndrs, thing) - HsForAllInvis { hsf_invis_bndrs = bndrs } -> do - (inv_tv_bndrs, thing) <- bindExplicitTKBndrs_Tv bndrs thing_inside - pure (Right inv_tv_bndrs, thing) -} -{- -TODO RGS: Consider renaming this to bindExplicitTKTele, as the QL patch does, -if there are no other variants that work over HsForAllTelescopes --} -- | Skolemise the 'HsTyVarBndr's in an 'HsForAllTelescope' with the supplied -- 'TcTyMode'. bindExplicitTKTele_Skol_M @@ -3217,52 +3207,38 @@ bindOuterFamEqnTKBndrs_Q_Tv :: ContextKind -> TcM a -> TcM ([TcTyVar], a) bindOuterFamEqnTKBndrs_Q_Tv ctxt_kind outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} -> do - bindImplicitTKBndrs_Q_Tv implicit_tkv_nms thing_inside - HsOuterExplicit{hso_bndrs = exp_bndrs} -> do - bindExplicitTKBndrs_Q_Tv ctxt_kind exp_bndrs thing_inside - --- TODO RGS: Docs(?) --- TODO RGS: Is the return type correct? --- TODO RGS: Consolidate with bindHsOuter*TKBndrs_Tv? -bindOuterGadtTKBndrs_Skol :: HsOuterGadtTyVarBndrs GhcRn - -> TcM a - -> TcM (Either [TcTyVar] [TcInvisTVBinder], a) -bindOuterGadtTKBndrs_Skol outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} -> do - (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside - pure (Left imp_tvs, thing) - HsOuterExplicit{hso_bndrs = exp_bndrs} -> do - (exp_bndrs', thing) <- bindExplicitTKBndrs_Skol exp_bndrs thing_inside - pure (Right exp_bndrs', thing) - --- TODO RGS: Docs(?) --- TODO RGS: Is the return type correct? --- TODO RGS: Consolidate with bindHsOuter*TKBndrs_Skol? -bindOuterGadtTKBndrs_Tv :: HsOuterGadtTyVarBndrs GhcRn - -> TcM a - -> TcM (Either [TcTyVar] [TcInvisTVBinder], a) -bindOuterGadtTKBndrs_Tv outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tv_names} -> do - (imp_tvs, thing) <- bindImplicitTKBndrs_Tv implicit_tv_names thing_inside - pure (Left imp_tvs, thing) - HsOuterExplicit{hso_bndrs = exp_bndrs} -> do - (exp_bndrs', thing) <- bindExplicitTKBndrs_Tv exp_bndrs thing_inside - pure (Right exp_bndrs', thing) + HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} + -> bindImplicitTKBndrs_Q_Tv implicit_tkv_nms thing_inside + HsOuterExplicit{hso_bndrs = exp_bndrs} + -> bindExplicitTKBndrs_Q_Tv ctxt_kind exp_bndrs thing_inside -- TODO RGS: Docs(?) -- TODO RGS: Is the return type correct? -- TODO RGS: Consolidate? bindOuterSigTKBndrs_Skol :: HsOuterSigTyVarBndrs GhcRn -> TcM a - -> TcM (Either [TcTyVar] [TcTyVarBinder], a) + -> TcM (Either [TcTyVar] [TcInvisTVBinder], a) bindOuterSigTKBndrs_Skol outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} -> do - (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside - pure (Left imp_tvs, thing) - HsOuterExplicit{hso_bndrs = exp_bndrs} -> do - (exp_bndrs', thing) <- bindExplicitTKTele_Skol exp_bndrs thing_inside - pure (Right exp_bndrs', thing) + HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} + -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside + ; pure (Left imp_tvs, thing) } + HsOuterExplicit{hso_bndrs = exp_bndrs} + -> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Skol exp_bndrs thing_inside + ; pure (Right exp_bndrs', thing) } + +-- TODO RGS: Docs(?) +-- TODO RGS: Is the return type correct? +-- TODO RGS: Consolidate with bindHsOuter*TKBndrs_Skol? +bindOuterSigTKBndrs_Tv :: HsOuterSigTyVarBndrs GhcRn + -> TcM a + -> TcM (Either [TcTyVar] [TcInvisTVBinder], a) +bindOuterSigTKBndrs_Tv outer_bndrs thing_inside = case outer_bndrs of + HsOuterImplicit{hso_ximplicit = implicit_tv_names} + -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Tv implicit_tv_names thing_inside + ; pure (Left imp_tvs, thing) } + HsOuterExplicit{hso_bndrs = exp_bndrs} + -> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Tv exp_bndrs thing_inside + ; pure (Right exp_bndrs', thing) } -- TODO RGS: Docs(?) -- TODO RGS: Is the return type correct? @@ -3270,14 +3246,29 @@ bindOuterSigTKBndrs_Skol outer_bndrs thing_inside = case outer_bndrs of bindOuterSigTKBndrs_Skol_M :: TcTyMode -> HsOuterSigTyVarBndrs GhcRn -> TcM a - -> TcM (Either [TcTyVar] [TcTyVarBinder], a) + -> TcM (Either [TcTyVar] [TcInvisTVBinder], a) bindOuterSigTKBndrs_Skol_M mode outer_bndrs thing_inside = case outer_bndrs of - HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} -> do - (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside - pure (Left imp_tvs, thing) - HsOuterExplicit{hso_bndrs = exp_bndrs} -> do - (exp_bndrs', thing) <- bindExplicitTKTele_Skol_M mode exp_bndrs thing_inside - pure (Right exp_bndrs', thing) + HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} + -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Skol implicit_tkv_nms thing_inside + ; pure (Left imp_tvs, thing) } + HsOuterExplicit{hso_bndrs = exp_bndrs} + -> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Skol_M mode exp_bndrs thing_inside + ; pure (Right exp_bndrs', thing) } + +-- TODO RGS: Docs(?) +-- TODO RGS: Is the return type correct? +-- TODO RGS: Consolidate? +bindOuterSigTKBndrs_Tv_M :: TcTyMode + -> HsOuterSigTyVarBndrs GhcRn + -> TcM a + -> TcM ([TcInvisTVBinder], a) +bindOuterSigTKBndrs_Tv_M mode outer_bndrs thing_inside = case outer_bndrs of + HsOuterImplicit{hso_ximplicit = implicit_tkv_nms} + -> do { (imp_tvs, thing) <- bindImplicitTKBndrs_Tv implicit_tkv_nms thing_inside + ; pure (mkTyVarBinders SpecifiedSpec imp_tvs, thing) } + HsOuterExplicit{hso_bndrs = exp_bndrs} + -> do { (exp_bndrs', thing) <- bindExplicitTKBndrs_Tv_M mode exp_bndrs thing_inside + ; pure (exp_bndrs', thing) } ----------------- tcHsTyVarBndr :: TcTyMode -> (Name -> Kind -> TcM TyVar) @@ -3732,6 +3723,7 @@ It isn't essential for correctness. -} +-- TODO RGS: Delete me tcHsPartialSigType :: UserTypeCtxt -> LHsSigWcType GhcRn -- The type signature @@ -3799,6 +3791,70 @@ tcHsPartialSigType ctxt sig_ty ; traceTc "tcHsPartialSigType" (ppr tv_prs) ; return (wcs, wcx, tv_prs, theta, tau) } +-- TODO RGS: This is the REAL tcHsPartialSigType. Delete the one above when ready. +tcHsPartialSigType' + :: UserTypeCtxt + -> LHsSigWcType' GhcRn -- The type signature + -> TcM ( [(Name, TcTyVar)] -- Wildcards + , Maybe TcType -- Extra-constraints wildcard + , [(Name,InvisTVBinder)] -- Original tyvar names, in correspondence with + -- the implicitly and explicitly bound type variables + , TcThetaType -- Theta part + , TcType ) -- Tau part +-- See Note [Checking partial type signatures] +tcHsPartialSigType' ctxt sig_ty + | HsWC { hswc_ext = sig_wcs, hswc_body = sig_ty } <- sig_ty + , L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body_ty}) <- sig_ty + , (L _ hs_ctxt, hs_tau) <- splitLHsQualTy body_ty + = addSigCtxt ctxt sig_ty $ + do { mode <- mkHoleMode TypeLevel HM_Sig + ; (imp_or_exp_tvbndrs, (wcs, wcx, theta, tau)) + <- solveLocalEqualities "tcHsPartialSigType" $ + -- See Note [Failure in local type signatures] + tcNamedWildCardBinders sig_wcs $ \ wcs -> + bindOuterSigTKBndrs_Tv_M mode outer_bndrs $ + do { -- Instantiate the type-class context; but if there + -- is an extra-constraints wildcard, just discard it here + (theta, wcx) <- tcPartialContext mode hs_ctxt + + ; ek <- newOpenTypeKind + ; tau <- addTypeCtxt hs_tau $ + tc_lhs_type mode hs_tau ek + + ; return (wcs, wcx, theta, tau) } + + -- No kind-generalization here: + ; kindGeneralizeNone (mkInvisForAllTys imp_or_exp_tvbndrs $ + mkPhiTy theta $ + tau) + + -- Spit out the wildcards (including the extra-constraints one) + -- as "hole" constraints, so that they'll be reported if necessary + -- See Note [Extra-constraint holes in partial type signatures] + ; mapM_ emitNamedTypeHole wcs + + -- Zonk, so that any nested foralls can "see" their occurrences + -- See Note [Checking partial type signatures], and in particular + -- Note [Levels for wildcards] + ; imp_or_exp_tvbndrs <- mapM zonkInvisTVBinder imp_or_exp_tvbndrs + ; theta <- mapM zonkTcType theta + ; tau <- zonkTcType tau + + -- We return a proper (Name,InvisTVBinder) environment, to be sure that + -- we bring the right name into scope in the function body. + -- Test case: partial-sigs/should_compile/LocalDefinitionBug + ; let imp_or_exp_hs_tvs = case outer_bndrs of + HsOuterImplicit{hso_ximplicit = imp_tvs} -> imp_tvs + HsOuterExplicit{hso_bndrs = exp_tvs} -> hsLTyVarNames exp_tvs + tv_prs = imp_or_exp_hs_tvs `zip` imp_or_exp_tvbndrs + + -- NB: checkValidType on the final inferred type will be + -- done later by checkInferredPolyId. We can't do it + -- here because we don't have a complete type to check + + ; traceTc "tcHsPartialSigType" (ppr tv_prs) + ; return (wcs, wcx, tv_prs, theta, tau) } + tcPartialContext :: TcTyMode -> HsContext GhcRn -> TcM (TcThetaType, Maybe TcType) tcPartialContext mode hs_theta | Just (hs_theta1, hs_ctxt_last) <- snocView hs_theta ===================================== compiler/GHC/Tc/Gen/Sig.hs ===================================== @@ -203,7 +203,7 @@ tcTySig (L loc (TypeSig _ names sig_ty)) tcTySig (L loc (PatSynSig _ names sig_ty)) = setSrcSpan loc $ - do { tpsigs <- sequence [ tcPatSynSig name sig_ty + do { tpsigs <- sequence [ tcPatSynSig' name sig_ty | L _ name <- names ] ; return (map TcPatSynSig tpsigs) } @@ -266,10 +266,22 @@ isCompleteHsSig :: LHsSigWcType GhcRn -> Bool -- ^ If there are no wildcards, return a LHsSigType isCompleteHsSig (HsWC { hswc_ext = wcs , hswc_body = HsIB { hsib_body = hs_ty } }) - = null wcs && no_anon_wc hs_ty - -no_anon_wc :: LHsType GhcRn -> Bool -no_anon_wc lty = go lty + = null wcs && no_anon_wc_ty hs_ty + +-- TODO RGS: This is the REAL isCompleteHsSig. Delete the one above when ready. +isCompleteHsSig' :: LHsSigWcType' GhcRn -> Bool +-- ^ If there are no wildcards, return a LHsSigWcType +isCompleteHsSig' (HsWC { hswc_ext = wcs, hswc_body = hs_sig_ty }) + = null wcs && no_anon_wc_sig_ty hs_sig_ty + +no_anon_wc_sig_ty :: LHsSigType' GhcRn -> Bool +no_anon_wc_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) = + case outer_bndrs of + HsOuterImplicit{} -> no_anon_wc_ty body + HsOuterExplicit{hso_bndrs = ltvs} -> all no_anon_wc_tvb ltvs && no_anon_wc_ty body + +no_anon_wc_ty :: LHsType GhcRn -> Bool +no_anon_wc_ty lty = go lty where go (L _ ty) = case ty of HsWildCardTy _ -> False @@ -304,11 +316,13 @@ no_anon_wc lty = go lty no_anon_wc_tele :: HsForAllTelescope GhcRn -> Bool no_anon_wc_tele tele = case tele of - HsForAllVis { hsf_vis_bndrs = ltvs } -> all (go . unLoc) ltvs - HsForAllInvis { hsf_invis_bndrs = ltvs } -> all (go . unLoc) ltvs - where - go (UserTyVar _ _ _) = True - go (KindedTyVar _ _ _ ki) = no_anon_wc ki + HsForAllVis { hsf_vis_bndrs = ltvs } -> all no_anon_wc_tvb ltvs + HsForAllInvis { hsf_invis_bndrs = ltvs } -> all no_anon_wc_tvb ltvs + +no_anon_wc_tvb :: LHsTyVarBndr flag GhcRn -> Bool +no_anon_wc_tvb (L _ tvb) = case tvb of + UserTyVar _ _ _ -> True + KindedTyVar _ _ _ ki -> no_anon_wc_ty ki {- Note [Fail eagerly on bad signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -475,6 +489,105 @@ tcPatSynSig name sig_ty mkPhiTy prov $ body +-- TODO RGS: This is the REAL tcPatSynSig. Delete the one above when ready. +tcPatSynSig' :: Name -> LHsSigType' GhcRn -> TcM TcPatSynInfo +-- See Note [Pattern synonym signatures] +-- See Note [Recipe for checking a signature] in GHC.Tc.Gen.HsType +tcPatSynSig' name sig_ty@(L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = hs_ty})) + | (hs_req, hs_ty1) <- splitLHsQualTy hs_ty + , (ex_hs_tvbndrs, hs_prov, hs_body_ty) <- splitLHsSigmaTyInvis hs_ty1 + = do { traceTc "tcPatSynSig 1" (ppr sig_ty) + ; (implicit_or_univ_tvbndrs, (ex_tvbndrs, (req, prov, body_ty))) + <- pushTcLevelM_ $ + solveEqualities $ -- See Note [solveEqualities in tcPatSynSig] + bindOuterSigTKBndrs_Skol outer_bndrs $ + bindExplicitTKBndrs_Skol ex_hs_tvbndrs $ + do { req <- tcHsContext hs_req + ; prov <- tcHsContext hs_prov + ; body_ty <- tcHsOpenType hs_body_ty + -- A (literal) pattern can be unlifted; + -- e.g. pattern Zero <- 0# (#12094) + ; return (req, prov, body_ty) } + + -- TODO RGS: Is this the cleanest way to do this? + ; let (implicit_tvs, univ_tvbndrs) = case implicit_or_univ_tvbndrs of + Left implicit_tvs' -> (implicit_tvs', []) + Right univ_tvbndrs' -> ([], univ_tvbndrs') + + ; let ungen_patsyn_ty = build_patsyn_type [] implicit_tvs univ_tvbndrs + req ex_tvbndrs prov body_ty + + -- Kind generalisation + ; kvs <- kindGeneralizeAll ungen_patsyn_ty + ; traceTc "tcPatSynSig" (ppr ungen_patsyn_ty) + + -- These are /signatures/ so we zonk to squeeze out any kind + -- unification variables. Do this after kindGeneralize which may + -- default kind variables to *. + ; implicit_tvs <- zonkAndScopedSort implicit_tvs + ; univ_tvbndrs <- mapM zonkTyCoVarKindBinder univ_tvbndrs + ; ex_tvbndrs <- mapM zonkTyCoVarKindBinder ex_tvbndrs + ; req <- zonkTcTypes req + ; prov <- zonkTcTypes prov + ; body_ty <- zonkTcType body_ty + + -- Skolems have TcLevels too, though they're used only for debugging. + -- If you don't do this, the debugging checks fail in GHC.Tc.TyCl.PatSyn. + -- Test case: patsyn/should_compile/T13441 +{- + ; tclvl <- getTcLevel + ; let env0 = mkEmptyTCvSubst $ mkInScopeSet $ mkVarSet kvs + (env1, implicit_tvs') = promoteSkolemsX tclvl env0 implicit_tvs + (env2, univ_tvs') = promoteSkolemsX tclvl env1 univ_tvs + (env3, ex_tvs') = promoteSkolemsX tclvl env2 ex_tvs + req' = substTys env3 req + prov' = substTys env3 prov + body_ty' = substTy env3 body_ty +-} + ; let implicit_tvs' = implicit_tvs + univ_tvbndrs' = univ_tvbndrs + ex_tvbndrs' = ex_tvbndrs + req' = req + prov' = prov + body_ty' = body_ty + + -- Now do validity checking + ; checkValidType ctxt $ + build_patsyn_type kvs implicit_tvs' univ_tvbndrs' req' ex_tvbndrs' prov' body_ty' + + -- arguments become the types of binders. We thus cannot allow + -- levity polymorphism here + ; let (arg_tys, _) = tcSplitFunTys body_ty' + ; mapM_ (checkForLevPoly empty . scaledThing) arg_tys + + ; traceTc "tcTySig }" $ + vcat [ text "implicit_tvs" <+> ppr_tvs implicit_tvs' + , text "kvs" <+> ppr_tvs kvs + , text "univ_tvs" <+> ppr_tvs (binderVars univ_tvbndrs') + , text "req" <+> ppr req' + , text "ex_tvs" <+> ppr_tvs (binderVars ex_tvbndrs') + , text "prov" <+> ppr prov' + , text "body_ty" <+> ppr body_ty' ] + ; return (TPSI { patsig_name = name + , patsig_implicit_bndrs = mkTyVarBinders InferredSpec kvs ++ + mkTyVarBinders SpecifiedSpec implicit_tvs' + , patsig_univ_bndrs = univ_tvbndrs' + , patsig_req = req' + , patsig_ex_bndrs = ex_tvbndrs' + , patsig_prov = prov' + , patsig_body_ty = body_ty' }) } + where + ctxt = PatSynCtxt name + + build_patsyn_type kvs imp univ_bndrs req ex_bndrs prov body + = mkInfForAllTys kvs $ + mkSpecForAllTys imp $ + mkInvisForAllTys univ_bndrs $ + mkPhiTy req $ + mkInvisForAllTys ex_bndrs $ + mkPhiTy prov $ + body + ppr_tvs :: [TyVar] -> SDoc ppr_tvs tvs = braces (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv) | tv <- tvs]) ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -2450,6 +2450,16 @@ getGhciStepIO = do let ghciM = nlHsAppTy (nlHsTyVar ghciTy) (nlHsTyVar a_tv) ioM = nlHsAppTy (nlHsTyVar ioTyConName) (nlHsTyVar a_tv) + {- + step_ty :: LHsSigType' GhcRn + step_ty = noLoc $ HsSig + { sig_bndrs = HsOuterImplicit{hso_ximplicit = [a_tv]} + , sig_ext = noExtField + , sig_body = nlHsFunTy HsUnrestrictedArrow ghciM ioM } + + stepTy :: LHsSigWcType' GhcRn + stepTy = mkEmptyWildCardBndrs step_ty + -} step_ty = noLoc $ HsForAllTy { hst_tele = mkHsForAllInvisTele [noLoc $ UserTyVar noExtField SpecifiedSpec (noLoc a_tv)] ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -1614,7 +1614,7 @@ kcConDecl new_or_data res_kind (ConDeclGADT -- for the type constructor T addErrCtxt (dataConCtxtName names) $ discardResult $ - bindOuterGadtTKBndrs_Tv outer_bndrs $ + bindOuterSigTKBndrs_Tv outer_bndrs $ -- Why "_Tv"? See Note [Kind-checking for GADTs] do { _ <- tcHsMbContext cxt ; kcConArgTys new_or_data res_kind (hsConDeclArgTys args) @@ -3268,7 +3268,7 @@ tcConDecl rep_tycon tag_map tmpl_bndrs _res_kind res_tmpl new_or_data <- pushTcLevelM_ $ -- We are going to generalise solveEqualities $ -- We won't get another crack, and we don't -- want an error cascade - bindOuterGadtTKBndrs_Skol outer_bndrs $ + bindOuterSigTKBndrs_Skol outer_bndrs $ do { ctxt <- tcHsMbContext cxt ; (res_ty, res_kind) <- tcInferLHsTypeKind hs_res_ty -- See Note [GADT return kinds] ===================================== compiler/GHC/Tc/TyCl/Class.hs ===================================== @@ -159,7 +159,7 @@ tcClassSigs clas sigs def_methods skol_info = TyConSkol ClassFlavour clas - tc_sig :: NameEnv (SrcSpan, Type) -> ([Located Name], LHsSigType GhcRn) + tc_sig :: NameEnv (SrcSpan, Type) -> ([Located Name], LHsSigType' GhcRn) -> TcM [TcMethInfo] tc_sig gen_dm_env (op_names, op_hs_ty) = do { traceTc "ClsSig 1" (ppr op_names) @@ -290,7 +290,7 @@ tcDefMeth clas tyvars this_dict binds_in hs_sig_fn prag_fn ; let local_dm_id = mkLocalId local_dm_name Many local_dm_ty local_dm_sig = CompleteSig { sig_bndr = local_dm_id , sig_ctxt = ctxt - , sig_loc = getLoc (hsSigType hs_ty) } + , sig_loc = getLoc hs_ty } ; (ev_binds, (tc_bind, _)) <- checkConstraints skol_info tyvars [this_dict] $ @@ -363,14 +363,14 @@ instantiateMethod clas sel_id inst_tys --------------------------- -type HsSigFun = Name -> Maybe (LHsSigType GhcRn) +type HsSigFun = Name -> Maybe (LHsSigType' GhcRn) mkHsSigFun :: [LSig GhcRn] -> HsSigFun mkHsSigFun sigs = lookupNameEnv env where env = mkHsSigEnv get_classop_sig sigs - get_classop_sig :: LSig GhcRn -> Maybe ([Located Name], LHsSigType GhcRn) + get_classop_sig :: LSig GhcRn -> Maybe ([Located Name], LHsSigType' GhcRn) get_classop_sig (L _ (ClassOpSig _ _ ns hs_ty)) = Just (ns, hs_ty) get_classop_sig _ = Nothing ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -480,7 +480,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds , cid_datafam_insts = adts })) = setSrcSpan loc $ addErrCtxt (instDeclCtxt1 hs_ty) $ - do { dfun_ty <- tcHsClsInstType (InstDeclCtxt False) hs_ty + do { dfun_ty <- tcHsClsInstType' (InstDeclCtxt False) hs_ty ; let (tyvars, theta, clas, inst_tys) = tcSplitDFunTy dfun_ty -- NB: tcHsClsInstType does checkValidInstance @@ -517,7 +517,7 @@ tcClsInstDecl (L loc (ClsInstDecl { cid_poly_ty = hs_ty, cid_binds = binds -- Finally, construct the Core representation of the instance. -- (This no longer includes the associated types.) - ; dfun_name <- newDFunName clas inst_tys (getLoc (hsSigType hs_ty)) + ; dfun_name <- newDFunName clas inst_tys (getLoc hs_ty) -- Dfun location is that of instance *header* ; ispec <- newClsInst (fmap unLoc overlap_mode) dfun_name @@ -1783,10 +1783,10 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind -- There is a signature in the instance -- See Note [Instance method signatures] = do { (sig_ty, hs_wrap) - <- setSrcSpan (getLoc (hsSigType hs_sig_ty)) $ + <- setSrcSpan (getLoc hs_sig_ty) $ do { inst_sigs <- xoptM LangExt.InstanceSigs ; checkTc inst_sigs (misplacedInstSig sel_name hs_sig_ty) - ; sig_ty <- tcHsSigType (FunSigCtxt sel_name False) hs_sig_ty + ; sig_ty <- tcLHsSigType (FunSigCtxt sel_name False) hs_sig_ty ; let local_meth_ty = idType local_meth_id ctxt = FunSigCtxt sel_name False -- False <=> do not report redundant constraints when @@ -1804,7 +1804,7 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind inner_meth_id = mkLocalId inner_meth_name Many sig_ty inner_meth_sig = CompleteSig { sig_bndr = inner_meth_id , sig_ctxt = ctxt - , sig_loc = getLoc (hsSigType hs_sig_ty) } + , sig_loc = getLoc hs_sig_ty } ; (tc_bind, [inner_id]) <- tcPolyCheck no_prag_fn inner_meth_sig meth_bind @@ -1873,7 +1873,7 @@ methSigCtxt sel_name sig_ty meth_ty env0 , text " Class sig:" <+> ppr meth_ty ]) ; return (env2, msg) } -misplacedInstSig :: Name -> LHsSigType GhcRn -> SDoc +misplacedInstSig :: Name -> LHsSigType' GhcRn -> SDoc misplacedInstSig name hs_ty = vcat [ hang (text "Illegal type signature in instance declaration:") 2 (hang (pprPrefixName name) @@ -2206,9 +2206,9 @@ tcSpecInst _ _ = panic "tcSpecInst" ************************************************************************ -} -instDeclCtxt1 :: LHsSigType GhcRn -> SDoc +instDeclCtxt1 :: LHsSigType' GhcRn -> SDoc instDeclCtxt1 hs_inst_ty - = inst_decl_ctxt (ppr (getLHsInstDeclHead hs_inst_ty)) + = inst_decl_ctxt (ppr (getLHsInstDeclHead' hs_inst_ty)) instDeclCtxt2 :: Type -> SDoc instDeclCtxt2 dfun_ty ===================================== compiler/GHC/ThToHs.hs ===================================== @@ -286,9 +286,10 @@ cvtDec (InstanceD o ctxt ty decs) ; unless (null fams') (failWith (mkBadDecMsg doc fams')) ; ctxt' <- cvtContext funPrec ctxt ; (L loc ty') <- cvtType ty - ; let inst_ty' = mkHsQualTy ctxt loc ctxt' $ L loc ty' + ; let inst_ty' = hsTypeToHsSigType $ + mkHsQualTy ctxt loc ctxt' $ L loc ty' ; returnJustL $ InstD noExtField $ ClsInstD noExtField $ - ClsInstDecl { cid_ext = noExtField, cid_poly_ty = mkLHsSigType inst_ty' + ClsInstDecl { cid_ext = noExtField, cid_poly_ty = inst_ty' , cid_binds = binds' , cid_sigs = Hs.mkClassOpSigs sigs' , cid_tyfam_insts = ats', cid_datafam_insts = adts' @@ -383,18 +384,19 @@ cvtDec (TH.StandaloneDerivD ds cxt ty) = do { cxt' <- cvtContext funPrec cxt ; ds' <- traverse cvtDerivStrategy ds ; (L loc ty') <- cvtType ty - ; let inst_ty' = mkHsQualTy cxt loc cxt' $ L loc ty' + ; let inst_ty' = hsTypeToHsSigType $ + mkHsQualTy cxt loc cxt' $ L loc ty' ; returnJustL $ DerivD noExtField $ DerivDecl { deriv_ext =noExtField , deriv_strategy = ds' - , deriv_type = mkLHsSigWcType inst_ty' + , deriv_type = mkHsWildCardBndrs inst_ty' , deriv_overlap_mode = Nothing } } cvtDec (TH.DefaultSigD nm typ) = do { nm' <- vNameL nm - ; ty' <- cvtType typ + ; ty' <- cvtSigType typ ; returnJustL $ Hs.SigD noExtField - $ ClassOpSig noExtField True [nm'] (mkLHsSigType ty')} + $ ClassOpSig noExtField True [nm'] ty'} cvtDec (TH.PatSynD nm args dir pat) = do { nm' <- cNameL nm @@ -421,7 +423,7 @@ cvtDec (TH.PatSynD nm args dir pat) cvtDec (TH.PatSynSigD nm ty) = do { nm' <- cNameL nm ; ty' <- cvtPatSynSigTy ty - ; returnJustL $ Hs.SigD noExtField $ PatSynSig noExtField [nm'] (mkLHsSigType ty')} + ; returnJustL $ Hs.SigD noExtField $ PatSynSig noExtField [nm'] ty'} -- Implicit parameter bindings are handled in cvtLocalDecs and -- cvtImplicitParamBind. They are not allowed in any other scope, so @@ -1413,8 +1415,8 @@ cvtDerivStrategy TH.StockStrategy = returnL Hs.StockStrategy cvtDerivStrategy TH.AnyclassStrategy = returnL Hs.AnyclassStrategy cvtDerivStrategy TH.NewtypeStrategy = returnL Hs.NewtypeStrategy cvtDerivStrategy (TH.ViaStrategy ty) = do - ty' <- cvtType ty - returnL $ Hs.ViaStrategy (mkLHsSigType ty') + ty' <- cvtSigType ty + returnL $ Hs.ViaStrategy ty' cvtType :: TH.Type -> CvtM (LHsType GhcPs) cvtType = cvtTypeKind "type" @@ -1426,10 +1428,7 @@ cvtSigType = cvtSigTypeKind "type" cvtSigTypeKind :: String -> TH.Type -> CvtM (LHsSigType' GhcPs) cvtSigTypeKind ty_str ty = do ty' <- cvtTypeKind ty_str ty - pure $ case ty' of - L loc (HsForAllTy { hst_tele = tele, hst_body = body }) - -> L loc $ mkHsExplicitSigType tele body - L loc _ -> L loc $ mkHsImplicitSigType ty' + pure $ hsTypeToHsSigType ty' cvtTypeKind :: String -> TH.Type -> CvtM (LHsType GhcPs) cvtTypeKind ty_str ty @@ -1760,30 +1759,28 @@ cvtInjectivityAnnotation (TH.InjectivityAnn annLHS annRHS) ; annRHS' <- mapM tNameL annRHS ; returnL (Hs.InjectivityAnn annLHS' annRHS') } -cvtPatSynSigTy :: TH.Type -> CvtM (LHsType GhcPs) +cvtPatSynSigTy :: TH.Type -> CvtM (LHsSigType' GhcPs) -- pattern synonym types are of peculiar shapes, which is why we treat -- them separately from regular types; -- see Note [Pattern synonym type signatures and Template Haskell] cvtPatSynSigTy (ForallT univs reqs (ForallT exis provs ty)) - | null exis, null provs = cvtType (ForallT univs reqs ty) + | null exis, null provs = cvtSigType (ForallT univs reqs ty) | null univs, null reqs = do { l <- getL ; ty' <- cvtType (ForallT exis provs ty) - ; return $ L l (HsQualTy { hst_ctxt = L l [] + ; return $ L l $ mkHsImplicitSigType + $ L l (HsQualTy { hst_ctxt = L l [] , hst_xqual = noExtField , hst_body = ty' }) } | null reqs = do { l <- getL ; univs' <- cvtTvs univs ; ty' <- cvtType (ForallT exis provs ty) - ; let forTy = HsForAllTy - { hst_tele = mkHsForAllInvisTele univs' - , hst_xforall = noExtField - , hst_body = L l cxtTy } + ; let forTy = mkHsExplicitSigType univs' $ L l cxtTy cxtTy = HsQualTy { hst_ctxt = L l [] , hst_xqual = noExtField , hst_body = ty' } ; return $ L l forTy } - | otherwise = cvtType (ForallT univs reqs (ForallT exis provs ty)) -cvtPatSynSigTy ty = cvtType ty + | otherwise = cvtSigType (ForallT univs reqs (ForallT exis provs ty)) +cvtPatSynSigTy ty = cvtSigType ty ----------------------------------------------------------- cvtFixity :: TH.Fixity -> Hs.Fixity ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr ===================================== @@ -39,32 +39,35 @@ [({ T17544.hs:6:3-4 } (Unqual {OccName: f1}))] - (HsIB - (NoExtField) - ({ T17544.hs:6:9-16 } - (HsFunTy - (NoExtField) - (HsUnrestrictedArrow) - ({ T17544.hs:6:9 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:6:9 } - (Unqual - {OccName: a})))) - ({ T17544.hs:6:14-16 } - (HsDocTy - (NoExtField) - ({ T17544.hs:6:14-16 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:6:14-16 } - (Unqual - {OccName: Int})))) - ({ T17544.hs:7:5-23 } - (HsDocString - " comment on Int")))))))))] + ({ T17544.hs:6:9-16 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:6:9-16 } + (HsFunTy + (NoExtField) + (HsUnrestrictedArrow) + ({ T17544.hs:6:9 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:6:9 } + (Unqual + {OccName: a})))) + ({ T17544.hs:6:14-16 } + (HsDocTy + (NoExtField) + ({ T17544.hs:6:14-16 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:6:14-16 } + (Unqual + {OccName: Int})))) + ({ T17544.hs:7:5-23 } + (HsDocString + " comment on Int"))))))))))] {Bag(Located (HsBind GhcPs)): []} [] @@ -99,26 +102,29 @@ [({ T17544.hs:10:3-4 } (Unqual {OccName: f2}))] - (HsIB - (NoExtField) - ({ T17544.hs:10:9-16 } - (HsFunTy - (NoExtField) - (HsUnrestrictedArrow) - ({ T17544.hs:10:9 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:10:9 } - (Unqual - {OccName: a})))) - ({ T17544.hs:10:14-16 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:10:14-16 } - (Unqual - {OccName: Int})))))))))] + ({ T17544.hs:10:9-16 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:10:9-16 } + (HsFunTy + (NoExtField) + (HsUnrestrictedArrow) + ({ T17544.hs:10:9 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:10:9 } + (Unqual + {OccName: a})))) + ({ T17544.hs:10:14-16 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:10:14-16 } + (Unqual + {OccName: Int}))))))))))] {Bag(Located (HsBind GhcPs)): []} [] @@ -156,26 +162,29 @@ [({ T17544.hs:14:3-4 } (Unqual {OccName: f3}))] - (HsIB - (NoExtField) - ({ T17544.hs:14:9-16 } - (HsFunTy - (NoExtField) - (HsUnrestrictedArrow) - ({ T17544.hs:14:9 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:14:9 } - (Unqual - {OccName: a})))) - ({ T17544.hs:14:14-16 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:14:14-16 } - (Unqual - {OccName: Int})))))))))] + ({ T17544.hs:14:9-16 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:14:9-16 } + (HsFunTy + (NoExtField) + (HsUnrestrictedArrow) + ({ T17544.hs:14:9 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:14:9 } + (Unqual + {OccName: a})))) + ({ T17544.hs:14:14-16 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:14:14-16 } + (Unqual + {OccName: Int}))))))))))] {Bag(Located (HsBind GhcPs)): []} [] @@ -216,26 +225,29 @@ [({ T17544.hs:18:3-4 } (Unqual {OccName: f4}))] - (HsIB - (NoExtField) - ({ T17544.hs:18:9-16 } - (HsFunTy - (NoExtField) - (HsUnrestrictedArrow) - ({ T17544.hs:18:9 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:18:9 } - (Unqual - {OccName: a})))) - ({ T17544.hs:18:14-16 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:18:14-16 } - (Unqual - {OccName: Int}))))))))) + ({ T17544.hs:18:9-16 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:18:9-16 } + (HsFunTy + (NoExtField) + (HsUnrestrictedArrow) + ({ T17544.hs:18:9 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:18:9 } + (Unqual + {OccName: a})))) + ({ T17544.hs:18:14-16 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:18:14-16 } + (Unqual + {OccName: Int})))))))))) ,({ T17544.hs:20:3-16 } (ClassOpSig (NoExtField) @@ -243,26 +255,29 @@ [({ T17544.hs:20:3-4 } (Unqual {OccName: g4}))] - (HsIB - (NoExtField) - ({ T17544.hs:20:9-16 } - (HsFunTy - (NoExtField) - (HsUnrestrictedArrow) - ({ T17544.hs:20:9 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:20:9 } - (Unqual - {OccName: a})))) - ({ T17544.hs:20:14-16 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:20:14-16 } - (Unqual - {OccName: Int})))))))))] + ({ T17544.hs:20:9-16 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:20:9-16 } + (HsFunTy + (NoExtField) + (HsUnrestrictedArrow) + ({ T17544.hs:20:9 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:20:9 } + (Unqual + {OccName: a})))) + ({ T17544.hs:20:14-16 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:20:14-16 } + (Unqual + {OccName: Int}))))))))))] {Bag(Located (HsBind GhcPs)): []} [] @@ -322,25 +337,28 @@ (NoExtField) (ClsInstDecl (NoExtField) - (HsIB - (NoExtField) - ({ T17544.hs:23:10-15 } - (HsAppTy - (NoExtField) - ({ T17544.hs:23:10-11 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:23:10-11 } - (Unqual - {OccName: C5})))) - ({ T17544.hs:23:13-15 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:23:13-15 } - (Unqual - {OccName: Int}))))))) + ({ T17544.hs:23:10-15 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:23:10-15 } + (HsAppTy + (NoExtField) + ({ T17544.hs:23:10-11 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:23:10-11 } + (Unqual + {OccName: C5})))) + ({ T17544.hs:23:13-15 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:23:13-15 } + (Unqual + {OccName: Int})))))))) {Bag(Located (HsBind GhcPs)): []} [] @@ -457,25 +475,28 @@ (NoExtField) (ClsInstDecl (NoExtField) - (HsIB - (NoExtField) - ({ T17544.hs:29:10-15 } - (HsAppTy - (NoExtField) - ({ T17544.hs:29:10-11 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:29:10-11 } - (Unqual - {OccName: C6})))) - ({ T17544.hs:29:13-15 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:29:13-15 } - (Unqual - {OccName: Int}))))))) + ({ T17544.hs:29:10-15 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:29:10-15 } + (HsAppTy + (NoExtField) + ({ T17544.hs:29:10-11 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:29:10-11 } + (Unqual + {OccName: C6})))) + ({ T17544.hs:29:13-15 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:29:13-15 } + (Unqual + {OccName: Int})))))))) {Bag(Located (HsBind GhcPs)): []} [] @@ -592,25 +613,28 @@ (NoExtField) (ClsInstDecl (NoExtField) - (HsIB - (NoExtField) - ({ T17544.hs:35:10-15 } - (HsAppTy - (NoExtField) - ({ T17544.hs:35:10-11 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:35:10-11 } - (Unqual - {OccName: C7})))) - ({ T17544.hs:35:13-15 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:35:13-15 } - (Unqual - {OccName: Int}))))))) + ({ T17544.hs:35:10-15 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:35:10-15 } + (HsAppTy + (NoExtField) + ({ T17544.hs:35:10-11 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:35:10-11 } + (Unqual + {OccName: C7})))) + ({ T17544.hs:35:13-15 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:35:13-15 } + (Unqual + {OccName: Int})))))))) {Bag(Located (HsBind GhcPs)): []} [] @@ -727,25 +751,28 @@ (NoExtField) (ClsInstDecl (NoExtField) - (HsIB - (NoExtField) - ({ T17544.hs:41:10-15 } - (HsAppTy - (NoExtField) - ({ T17544.hs:41:10-11 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:41:10-11 } - (Unqual - {OccName: C8})))) - ({ T17544.hs:41:13-15 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:41:13-15 } - (Unqual - {OccName: Int}))))))) + ({ T17544.hs:41:10-15 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:41:10-15 } + (HsAppTy + (NoExtField) + ({ T17544.hs:41:10-11 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:41:10-11 } + (Unqual + {OccName: C8})))) + ({ T17544.hs:41:13-15 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:41:13-15 } + (Unqual + {OccName: Int})))))))) {Bag(Located (HsBind GhcPs)): []} [] @@ -862,25 +889,28 @@ (NoExtField) (ClsInstDecl (NoExtField) - (HsIB - (NoExtField) - ({ T17544.hs:47:10-15 } - (HsAppTy - (NoExtField) - ({ T17544.hs:47:10-11 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:47:10-11 } - (Unqual - {OccName: C9})))) - ({ T17544.hs:47:13-15 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:47:13-15 } - (Unqual - {OccName: Int}))))))) + ({ T17544.hs:47:10-15 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:47:10-15 } + (HsAppTy + (NoExtField) + ({ T17544.hs:47:10-11 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:47:10-11 } + (Unqual + {OccName: C9})))) + ({ T17544.hs:47:13-15 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:47:13-15 } + (Unqual + {OccName: Int})))))))) {Bag(Located (HsBind GhcPs)): []} [] @@ -997,25 +1027,28 @@ (NoExtField) (ClsInstDecl (NoExtField) - (HsIB - (NoExtField) - ({ T17544.hs:53:10-16 } - (HsAppTy - (NoExtField) - ({ T17544.hs:53:10-12 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:53:10-12 } - (Unqual - {OccName: C10})))) - ({ T17544.hs:53:14-16 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544.hs:53:14-16 } - (Unqual - {OccName: Int}))))))) + ({ T17544.hs:53:10-16 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544.hs:53:10-16 } + (HsAppTy + (NoExtField) + ({ T17544.hs:53:10-12 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:53:10-12 } + (Unqual + {OccName: C10})))) + ({ T17544.hs:53:14-16 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544.hs:53:14-16 } + (Unqual + {OccName: Int})))))))) {Bag(Located (HsBind GhcPs)): []} [] ===================================== testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr ===================================== @@ -133,15 +133,18 @@ [({ T17544_kw.hs:24:5-13 } (Unqual {OccName: clsmethod}))] - (HsIB - (NoExtField) - ({ T17544_kw.hs:24:18 } - (HsTyVar - (NoExtField) - (NotPromoted) - ({ T17544_kw.hs:24:18 } - (Unqual - {OccName: a})))))))] + ({ T17544_kw.hs:24:18 } + (HsSig + (NoExtField) + (HsOuterImplicit + (NoExtField)) + ({ T17544_kw.hs:24:18 } + (HsTyVar + (NoExtField) + (NotPromoted) + ({ T17544_kw.hs:24:18 } + (Unqual + {OccName: a}))))))))] {Bag(Located (HsBind GhcPs)): []} [] ===================================== testsuite/tests/patsyn/should_fail/T11039.stderr ===================================== @@ -5,6 +5,6 @@ T11039.hs:8:15: error: Actual: A a ‘f’ is a rigid type variable bound by the signature for pattern synonym ‘Q’ - at T11039.hs:7:1-38 + at T11039.hs:7:14-38 • In the pattern: A a In the declaration for pattern synonym ‘Q’ ===================================== testsuite/tests/patsyn/should_fail/T11667.stderr ===================================== @@ -17,7 +17,7 @@ T11667.hs:18:28: error: the signature of ‘Pat2’ ‘b’ is a rigid type variable bound by the signature for pattern synonym ‘Pat2’ - at T11667.hs:17:1-50 + at T11667.hs:17:17-50 • In the declaration for pattern synonym ‘Pat2’ • Relevant bindings include y :: b (bound at T11667.hs:18:21) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8767ff95effa4a3d8d8859d3be04a209664d08b1 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8767ff95effa4a3d8d8859d3be04a209664d08b1 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 22:15:34 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Mon, 07 Sep 2020 18:15:34 -0400 Subject: [Git][ghc/ghc][wip/T18599] Restore a comment to how it is on master Message-ID: <5f56b1063cb53_80b3f84383d23801095057b@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: 4412aba6 by Shayne Fletcher at 2020-09-07T18:15:19-04:00 Restore a comment to how it is on master - - - - - 1 changed file: - compiler/GHC/Parser.y Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -3220,7 +3220,7 @@ qual :: { forall b. DisambECP b => PV (LStmt GhcPs (Located b)) } (mj AnnLet $1:(fst $ unLoc $2)) } ----------------------------------------------------------------------------- --- Record construction (expressions & patterns), top-level updates. +-- Record Field Update/Construction fbinds :: { forall b. DisambECP b => PV ([AddAnn],([Fbind b], Maybe SrcSpan)) } : fbinds1 { $1 } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4412aba61920596ef7a339d3d2207a65833c301f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4412aba61920596ef7a339d3d2207a65833c301f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 22:16:36 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Mon, 07 Sep 2020 18:16:36 -0400 Subject: [Git][ghc/ghc][wip/T18639-remove-generated-pragma] Remove GENERATED pragma, as it is not being used Message-ID: <5f56b144dfc59_80b3f8494cebd3410950787@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/T18639-remove-generated-pragma at Glasgow Haskell Compiler / GHC Commits: 3955bafc by Alan Zimmerman at 2020-09-07T23:15:53+01:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Closes #18639 - - - - - 18 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - testsuite/tests/ghc-api/annotations/T10313.stdout - testsuite/tests/ghc-api/annotations/T11430.stdout - testsuite/tests/ghc-api/annotations/Test10313.hs - testsuite/tests/ghc-api/annotations/Test11430.hs - testsuite/tests/ghc-api/annotations/stringSource.hs - testsuite/tests/ghc-api/annotations/t11430.hs - testsuite/tests/printer/Makefile - − testsuite/tests/printer/Ppr047.hs - testsuite/tests/printer/all.T - utils/haddock Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -838,21 +838,10 @@ data HsPragE p -- 'GHC.Parser.Annotation.AnnVal', -- 'GHC.Parser.Annotation.AnnClose' @'\#-}'@ - -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsPragTick -- A pragma introduced tick - (XTickPragma p) - SourceText -- Note [Pragma source text] in GHC.Types.Basic - (StringLiteral,(Int,Int),(Int,Int)) - -- external span for this tick - ((SourceText,SourceText),(SourceText,SourceText)) - -- Source text for the four integers used in the span. - -- See note [Pragma source text] in GHC.Types.Basic - | XHsPragE !(XXPragE p) type instance XSCC (GhcPass _) = NoExtField type instance XCoreAnn (GhcPass _) = NoExtField -type instance XTickPragma (GhcPass _) = NoExtField type instance XXPragE (GhcPass _) = NoExtCon -- | Located Haskell Tuple Argument @@ -1402,13 +1391,6 @@ instance Outputable (HsPragE (GhcPass p)) where -- no doublequotes if stl empty, for the case where the SCC was written -- without quotes. <+> pprWithSourceText stl (ftext lbl) <+> text "#-}" - ppr (HsPragTick _ st (StringLiteral sta s, (v1,v2), (v3,v4)) ((s1,s2),(s3,s4))) = - pprWithSourceText st (text "{-# GENERATED") - <+> pprWithSourceText sta (doubleQuotes $ ftext s) - <+> pprWithSourceText s1 (ppr v1) <+> char ':' <+> pprWithSourceText s2 (ppr v2) - <+> char '-' - <+> pprWithSourceText s3 (ppr v3) <+> char ':' <+> pprWithSourceText s4 (ppr v4) - <+> text "#-}" {- ************************************************************************ ===================================== compiler/GHC/HsToCore/Coverage.hs ===================================== @@ -618,10 +618,6 @@ addTickHsExpr (HsTick x t e) = addTickHsExpr (HsBinTick x t0 t1 e) = liftM (HsBinTick x t0 t1) (addTickLHsExprNever e) -addTickHsExpr (HsPragE _ HsPragTick{} (L pos e0)) = do - e2 <- allocTickBox (ExpBox False) False False pos $ - addTickHsExpr e0 - return $ unLoc e2 addTickHsExpr (HsPragE x p e) = liftM (HsPragE x p) (addTickLHsExpr e) addTickHsExpr e@(HsBracket {}) = return e ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -820,11 +820,6 @@ ds_prag_expr (HsPragSCC _ _ cc) expr = do Tick (ProfNote (mkUserCC nm mod_name (getLoc expr) flavour) count True) <$> dsLExpr expr else dsLExpr expr -ds_prag_expr (HsPragTick _ _ _ _) expr = do - dflags <- getDynFlags - if gopt Opt_Hpc dflags - then panic "dsExpr:HsPragTick" - else dsLExpr expr ------------------------------ dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1572,7 +1572,6 @@ repE (HsUnboundVar _ uv) = do repUnboundVar sname repE (XExpr (HsExpanded _ b)) = repE b repE e@(HsPragE _ HsPragSCC {} _) = notHandled "Cost centres" (ppr e) -repE e@(HsPragE _ HsPragTick {} _) = notHandled "Tick Pragma" (ppr e) repE e = notHandled "Expression form" (ppr e) ----------------------------------------------------------------------------- ===================================== compiler/GHC/Parser.y ===================================== @@ -514,7 +514,6 @@ are the most common patterns, rewritten as regular expressions for clarity: '{-# SOURCE' { L _ (ITsource_prag _) } '{-# RULES' { L _ (ITrules_prag _) } '{-# SCC' { L _ (ITscc_prag _)} - '{-# GENERATED' { L _ (ITgenerated_prag _) } '{-# DEPRECATED' { L _ (ITdeprecated_prag _) } '{-# WARNING' { L _ (ITwarning_prag _) } '{-# UNPACK' { L _ (ITunpack_prag _) } @@ -2525,8 +2524,7 @@ optSemi :: { ([Located Token],Bool) } {- Note [Pragmas and operator fixity] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -'prag_e' is an expression pragma, such as {-# SCC ... #-} or -{-# GENERATED ... #-}. +'prag_e' is an expression pragma, such as {-# SCC ... #-}. It must be used with care, or else #15730 happens. Consider this infix expression: @@ -2580,20 +2578,6 @@ prag_e :: { Located ([AddAnn], HsPragE GhcPs) } HsPragSCC noExtField (getSCC_PRAGs $1) (StringLiteral NoSourceText (getVARID $2))) } - | '{-# GENERATED' STRING INTEGER ':' INTEGER HYPHEN INTEGER ':' INTEGER '#-}' - { let getINT = fromInteger . il_value . getINTEGER in - sLL $1 $> $ ([mo $1,mj AnnVal $2 - ,mj AnnVal $3,mj AnnColon $4 - ,mj AnnVal $5] ++ $6 ++ - [mj AnnVal $7,mj AnnColon $8 - ,mj AnnVal $9,mc $10], - HsPragTick noExtField - (getGENERATED_PRAGs $1) - (getStringLiteral $2, - (getINT $3, getINT $5), - (getINT $7, getINT $9)) - ((getINTEGERs $3, getINTEGERs $5), - (getINTEGERs $7, getINTEGERs $9) )) } fexp :: { ECP } : fexp aexp { ECP $ superFunArg $ @@ -3700,7 +3684,6 @@ getRULES_PRAGs (L _ (ITrules_prag src)) = src getWARNING_PRAGs (L _ (ITwarning_prag src)) = src getDEPRECATED_PRAGs (L _ (ITdeprecated_prag src)) = src getSCC_PRAGs (L _ (ITscc_prag src)) = src -getGENERATED_PRAGs (L _ (ITgenerated_prag src)) = src getUNPACK_PRAGs (L _ (ITunpack_prag src)) = src getNOUNPACK_PRAGs (L _ (ITnounpack_prag src)) = src getANN_PRAGs (L _ (ITann_prag src)) = src ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -743,7 +743,6 @@ data Token | ITline_prag SourceText -- not usually produced, see 'UsePosPragsBit' | ITcolumn_prag SourceText -- not usually produced, see 'UsePosPragsBit' | ITscc_prag SourceText - | ITgenerated_prag SourceText | ITunpack_prag SourceText | ITnounpack_prag SourceText | ITann_prag SourceText @@ -3289,7 +3288,6 @@ oneWordPrags = Map.fromList [ ("warning", strtoken (\s -> ITwarning_prag (SourceText s))), ("deprecated", strtoken (\s -> ITdeprecated_prag (SourceText s))), ("scc", strtoken (\s -> ITscc_prag (SourceText s))), - ("generated", strtoken (\s -> ITgenerated_prag (SourceText s))), ("unpack", strtoken (\s -> ITunpack_prag (SourceText s))), ("nounpack", strtoken (\s -> ITnounpack_prag (SourceText s))), ("ann", strtoken (\s -> ITann_prag (SourceText s))), ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -243,7 +243,6 @@ rnExpr (HsPragE x prag expr) where rn_prag :: HsPragE GhcPs -> HsPragE GhcRn rn_prag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann - rn_prag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo rnExpr (HsLam x matches) = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1082,7 +1082,6 @@ tcExpr other _ = pprPanic "tcLExpr" (ppr other) tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc tcExprPrag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann -tcExprPrag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo {- ********************************************************************* ===================================== testsuite/tests/ghc-api/annotations/T10313.stdout ===================================== @@ -10,5 +10,4 @@ ([c], [(SourceText "foo\x63", fooc), (SourceText "b\x61r", bar)]), ([r], [(SourceText "foo1\x67", foo1g)]), ([s, t], [(SourceText "a\x62", ab)]), - ([s, c], [(SourceText "foo\x64", food)]), - ([t, p], [(SourceText "foob\x61r", foobar)])] + ([s, c], [(SourceText "foo\x64", food)])] ===================================== testsuite/tests/ghc-api/annotations/T11430.stdout ===================================== @@ -3,4 +3,3 @@ ("ia",["1"]) ("ia",["0x999"]) ("ia",["1"]) -("tp",["((SourceText \"0x1\",SourceText \"0x2\"),(SourceText \"0x3\",SourceText \"0x4\"))"]) ===================================== testsuite/tests/ghc-api/annotations/Test10313.hs ===================================== @@ -33,5 +33,3 @@ strictStream (Bitstream l v) Exact l b = {-# SCC "foo\x64" #-} 006 - -c = {-# GENERATED "foob\x61r" 1 : 2 - 3 : 4 #-} 0.00 ===================================== testsuite/tests/ghc-api/annotations/Test11430.hs ===================================== @@ -21,5 +21,3 @@ x = undefined {-# INLINABLE [1] y #-} y :: (Num a, Integral b) => a -> b -> a y = undefined - -c = {-# GENERATED "foob\x61r" 0x1 : 0x2 - 0x3 : 0x4 #-} 0.00 ===================================== testsuite/tests/ghc-api/annotations/stringSource.hs ===================================== @@ -86,7 +86,6 @@ testOneFile libdir fileName = do doPragE :: HsPragE GhcPs -> [(String,[Located (SourceText,FastString)])] doPragE (HsPragSCC _ src ss) = [("sc",[conv (noLoc ss)])] - doPragE (HsPragTick _ src (ss,_,_) _ss2) = [("tp",[conv (noLoc ss)])] conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs) ===================================== testsuite/tests/ghc-api/annotations/t11430.hs ===================================== @@ -68,7 +68,6 @@ testOneFile libdir fileName = do doRuleDecl (HsRule _ _ _ _ _ _ _) = [] doHsExpr :: HsExpr GhcPs -> [(String,[String])] - doHsExpr (HsPragE _ (HsPragTick _ src (_,_,_) ss) _) = [("tp",[show ss])] doHsExpr _ = [] doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _) ===================================== testsuite/tests/printer/Makefile ===================================== @@ -190,10 +190,6 @@ ppr045: ppr046: $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr046.hs -.PHONY: ppr047 -ppr047: - $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr047.hs - .PHONY: ppr048 ppr048: $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr048.hs ===================================== testsuite/tests/printer/Ppr047.hs deleted ===================================== @@ -1,3 +0,0 @@ -module ExprPragmas where - -c = {-# GENERATED "foobar" 1 : 2 - 3 : 4 #-} 0.00 ===================================== testsuite/tests/printer/all.T ===================================== @@ -44,7 +44,6 @@ test('Ppr043', [ignore_stderr, req_interp], makefile_test, ['ppr043']) test('Ppr044', ignore_stderr, makefile_test, ['ppr044']) test('Ppr045', ignore_stderr, makefile_test, ['ppr045']) test('Ppr046', ignore_stderr, makefile_test, ['ppr046']) -test('Ppr047', ignore_stderr, makefile_test, ['ppr047']) test('Ppr048', ignore_stderr, makefile_test, ['ppr048']) test('T13199', [ignore_stderr, req_interp], makefile_test, ['T13199']) test('T13050p', ignore_stderr, makefile_test, ['T13050p']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 54468d1e60cb10093120137766cfc9dd91671c98 +Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3955bafc375c48ba11efc42e5d891abc178993f6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3955bafc375c48ba11efc42e5d891abc178993f6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Mon Sep 7 23:06:48 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Mon, 07 Sep 2020 19:06:48 -0400 Subject: [Git][ghc/ghc][wip/T18660] Make the forall-or-nothing rule only apply to invisible foralls (#18660) Message-ID: <5f56bd0817fc0_80beddfa1410959922@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/T18660 at Glasgow Haskell Compiler / GHC Commits: e37bd14b by Ryan Scott at 2020-09-07T19:06:32-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 5 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - docs/users_guide/exts/explicit_forall.rst - + testsuite/tests/dependent/should_compile/T18660.hs - testsuite/tests/dependent/should_compile/all.T Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Hs.Type ( mkEmptyImplicitBndrs, mkEmptyWildCardBndrs, mkHsForAllVisTele, mkHsForAllInvisTele, mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, - isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy, + isHsKindedTyVar, hsTvbAllKinded, isLHsInvisForAllTy, hsScopedTvs, hsWcScopedTvs, dropWildCards, hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames, @@ -1278,9 +1278,12 @@ ignoreParens :: LHsType (GhcPass p) -> LHsType (GhcPass p) ignoreParens (L _ (HsParTy _ ty)) = ignoreParens ty ignoreParens ty = ty -isLHsForAllTy :: LHsType (GhcPass p) -> Bool -isLHsForAllTy (L _ (HsForAllTy {})) = True -isLHsForAllTy _ = False +-- | Is this type headed by an invisible @forall@? This is used to determine +-- if the type variables in a type should be implicitly quantified. +-- See @Note [forall-or-nothing rule]@ in "GHC.Rename.HsType". +isLHsInvisForAllTy :: LHsType (GhcPass p) -> Bool +isLHsInvisForAllTy (L _ (HsForAllTy{hst_tele = HsForAllInvis{}})) = True +isLHsInvisForAllTy _ = False {- ************************************************************************ ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -168,7 +168,7 @@ rn_hs_sig_wc_type scoping ctxt hs_ty thing_inside ; let nwc_rdrs = nubL nwc_rdrs' ; implicit_bndrs <- case scoping of AlwaysBind -> pure tv_rdrs - BindUnlessForall -> forAllOrNothing (isLHsForAllTy hs_ty) tv_rdrs + BindUnlessForall -> forAllOrNothing (isLHsInvisForAllTy hs_ty) tv_rdrs NeverBind -> pure [] ; rnImplicitBndrs Nothing implicit_bndrs $ \ vars -> do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty @@ -321,7 +321,7 @@ rnHsSigType :: HsDocContext rnHsSigType ctx level (HsIB { hsib_body = hs_ty }) = do { traceRn "rnHsSigType" (ppr hs_ty) ; rdr_env <- getLocalRdrEnv - ; vars0 <- forAllOrNothing (isLHsForAllTy hs_ty) + ; vars0 <- forAllOrNothing (isLHsInvisForAllTy hs_ty) $ filterInScope rdr_env $ extractHsTyRdrTyVars hs_ty ; rnImplicitBndrs Nothing vars0 $ \ vars -> @@ -331,17 +331,43 @@ rnHsSigType ctx level (HsIB { hsib_body = hs_ty }) , hsib_body = body' } , fvs ) } } --- Note [forall-or-nothing rule] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Free variables in signatures are usually bound in an implicit --- 'forall' at the beginning of user-written signatures. However, if the --- signature has an explicit forall at the beginning, this is disabled. --- --- The idea is nested foralls express something which is only --- expressible explicitly, while a top level forall could (usually) be --- replaced with an implicit binding. Top-level foralls alone ("forall.") are --- therefore an indication that the user is trying to be fastidious, so --- we don't implicitly bind any variables. +{- +Note [forall-or-nothing rule] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Free variables in signatures are usually bound in an implicit 'forall' at the +beginning of user-written signatures. However, if the signature has an +explicit, invisible forall at the beginning, this is disabled. + +The idea is nested foralls express something which is only expressible +explicitly, while a top level forall could (usually) be replaced with an +implicit binding. Top-level foralls alone ("forall.") are therefore an +indication that the user is trying to be fastidious, so we don't implicitly +bind any variables. + +Note that this rule only applies to outermost /in/visible 'forall's, and not +outermost visible 'forall's. See #18660 for more on this point. + +Here are some concrete examples to demonstrate the forall-or-nothing rule in +action: + + type F1 :: a -> b -> b -- Legal; a,b are implicitly quantified. + -- Equivalently: forall a b. a -> b -> b + + type F2 :: forall a b. a -> b -> b -- Legal; explicitly quantified + + type F3 :: forall a. a -> b -> b -- Illegal; the forall-or-nothing rule says that + -- if you quantify a, you must also quantify b + + type F4 :: forall a -> b -> b -- Legal; the top quantifier (forall a) is a /visible/ + -- quantifer, so the "nothing" part of the forall-or-nothing + -- rule applies, and b is therefore implicitly quantified. + -- Equivalently: forall b. forall a -> b -> b + + type F5 :: forall b. forall a -> b -> c -- Illegal; the forall-or-nothing rule says that + -- if you quantify b, you must also quantify c + + type F6 :: forall a -> forall b. b -> c -- Legal: just like F4. +-} -- | See @Note [forall-or-nothing rule]@. This tiny little function is used -- (rather than its small body inlined) to indicate that we are implementing ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -56,30 +56,32 @@ The ``forall``-or-nothing rule ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In certain forms of types, type variables obey what is known as the -"``forall``-or-nothing" rule: if a type has an outermost, explicit -``forall``, then all of the type variables in the type must be explicitly -quantified. These two examples illustrate how the rule works: :: +"``forall``-or-nothing" rule: if a type has an outermost, explicit, +invisible ``forall``, then all of the type variables in the type must be +explicitly quantified. These two examples illustrate how the rule works: :: f :: forall a b. a -> b -> b -- OK, `a` and `b` are explicitly bound g :: forall a. a -> forall b. b -> b -- OK, `a` and `b` are explicitly bound h :: forall a. a -> b -> b -- Rejected, `b` is not in scope The type signatures for ``f``, ``g``, and ``h`` all begin with an outermost -``forall``, so every type variable in these signatures must be explicitly -bound by a ``forall``. Both ``f`` and ``g`` obey the ``forall``-or-nothing -rule, since they explicitly quantify ``a`` and ``b``. On the other hand, -``h`` does not explicitly quantify ``b``, so GHC will reject its type -signature for being improperly scoped. +invisible ``forall``, so every type variable in these signatures must be +explicitly bound by a ``forall``. Both ``f`` and ``g`` obey the +``forall``-or-nothing rule, since they explicitly quantify ``a`` and ``b``. On +the other hand, ``h`` does not explicitly quantify ``b``, so GHC will reject +its type signature for being improperly scoped. In places where the ``forall``-or-nothing rule takes effect, if a type does -*not* have an outermost ``forall``, then any type variables that are not -explicitly bound by a ``forall`` become implicitly quantified. For example: :: +*not* have an outermost invisible ``forall``, then any type variables that are +not explicitly bound by a ``forall`` become implicitly quantified. For example: :: i :: a -> b -> b -- `a` and `b` are implicitly quantified j :: a -> forall b. b -> b -- `a` is implicitly quantified k :: (forall a. a -> b -> b) -- `b` is implicitly quantified + type L :: forall a -> b -> b -- `b` is implicitly quantified -GHC will accept ``i``, ``j``, and ``k``'s type signatures. Note that: +GHC will accept ``i``, ``j``, and ``k``'s type signatures, as well as ``L``'s +kind signature. Note that: - ``j``'s signature is accepted despite its mixture of implicit and explicit quantification. As long as a ``forall`` is not an outermost one, it is fine @@ -88,6 +90,9 @@ GHC will accept ``i``, ``j``, and ``k``'s type signatures. Note that: the ``forall`` is not an outermost ``forall``. The ``forall``-or-nothing rule is one of the few places in GHC where the presence or absence of parentheses can be semantically significant! +- ``L``'s signature begins with an outermost ``forall``, but it is a *visible* + ``forall``, not an invisible ``forall``, and therefore does not trigger the + ``forall``-or-nothing rule. The ``forall``-or-nothing rule takes effect in the following places: ===================================== testsuite/tests/dependent/should_compile/T18660.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T18660 where + +type F :: forall a -> b -> b +type F x y = y ===================================== testsuite/tests/dependent/should_compile/all.T ===================================== @@ -66,3 +66,4 @@ test('T16326_Compile2', normal, compile, ['']) test('T16391a', normal, compile, ['']) test('T16344b', normal, compile, ['']) test('T16347', normal, compile, ['']) +test('T18660', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e37bd14b85c86eca48345beeb1dc94cdf6bb1327 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e37bd14b85c86eca48345beeb1dc94cdf6bb1327 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 00:22:35 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Mon, 07 Sep 2020 20:22:35 -0400 Subject: [Git][ghc/ghc][wip/wire-in-constraint-tuples] 2 commits: Make sure we can read past perf notes Message-ID: <5f56cecb493fc_80b3f84141e7d8c109664bd@gitlab.haskell.org.mail> Ryan Scott pushed to branch wip/wire-in-constraint-tuples at Glasgow Haskell Compiler / GHC Commits: 0a0db8b0 by Krzysztof Gogolewski at 2020-09-07T19:10:44-04:00 Make sure we can read past perf notes See #18656. - - - - - 840ec043 by Ryan Scott at 2020-09-07T20:21:13-04:00 Wire in constraint tuples This wires in the definitions of the constraint tuple classes. The key changes are in: * `GHC.Builtin.Types`, where the `mk_ctuple` function is used to define constraint tuple type constructors, data constructors, and superclass selector functions, and * `GHC.Builtin.Uniques`. In addition to wiring in the `Unique`s for constraint tuple type and data constructors, we now must wire in the superclass selector functions. Luckily, this proves to be not that challenging. See the newly added comments. Historical note: constraint tuples used to be wired-in until about five years ago, when commit 130e93aab220bdf14d08028771f83df210da340b turned them into known-key names. This was done as part of a larger refactor to reduce the number of special cases for constraint tuples, but the commit message notes that the main reason that constraint tuples were made known-key (as opposed to boxed/unboxed tuples, which are wired in) is because it was awkward to wire in the superclass selectors. This commit solves the problem of wiring in superclass selectors. Fixes #18635. ------------------------- Metric Decrease: T10421 T12150 T12227 T12234 T12425 T13056 T13253-spj T18282 T18304 T5321FD T5321Fun T5837 T9961 Metric Decrease (test_env='x86_64-linux-deb9-unreg-hadrian'): T12707 Metric Decrease (test_env='x86_64-darwin'): T4029 ------------------------- - - - - - 7 changed files: - compiler/GHC/Builtin/Types.hs - compiler/GHC/Builtin/Types.hs-boot - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Types/Basic.hs - testsuite/driver/perf_notes.py Changes: ===================================== compiler/GHC/Builtin/Types.hs ===================================== @@ -80,9 +80,10 @@ module GHC.Builtin.Types ( unboxedTupleKind, unboxedSumKind, -- ** Constraint tuples - cTupleTyConName, cTupleTyConNames, isCTupleTyConName, + cTupleTyCon, cTupleTyConName, cTupleTyConNames, isCTupleTyConName, cTupleTyConNameArity_maybe, - cTupleDataConName, cTupleDataConNames, + cTupleDataCon, cTupleDataConName, cTupleDataConNames, + cTupleSelId, cTupleSelIdName, -- * Any anyTyCon, anyTy, anyTypeOfKind, @@ -174,10 +175,9 @@ import GHC.Core.Class ( Class, mkClass ) import GHC.Types.Name.Reader import GHC.Types.Name as Name import GHC.Types.Name.Env ( NameEnv, mkNameEnv, lookupNameEnv, lookupNameEnv_NF ) -import GHC.Types.Name.Set ( NameSet, mkNameSet, elemNameSet ) import GHC.Types.Basic import GHC.Types.ForeignCall -import GHC.Types.SrcLoc ( noSrcSpan ) +import GHC.Types.Unique.Set import Data.Array import GHC.Data.FastString import GHC.Data.BooleanFormula ( mkAnd ) @@ -723,20 +723,23 @@ Note [How tuples work] See also Note [Known-key names] in GHC.Builtin.Names but no actual declaration and no info table * ConstraintTuples - - Are known-key rather than wired-in. Reason: it's awkward to - have all the superclass selectors wired-in. + - A wired-in type. - Declared as classes in GHC.Classes, e.g. class (c1,c2) => (c1,c2) - Given constraints: the superclasses automatically become available - Wanted constraints: there is a built-in instance instance (c1,c2) => (c1,c2) - See GHC.Tc.Solver.Interact.matchCTuple + See GHC.Tc.Instance.Class.matchCTuple - Currently just go up to 62; beyond that you have to use manual nesting - Their OccNames look like (%,,,%), so they can easily be distinguished from term tuples. But (following Haskell) we pretty-print saturated constraint tuples with round parens; see BasicTypes.tupleParens. + - Unlike BoxedTuples and UnboxedTuples, which only wire + in type constructors and data constructors, ConstraintTuples also wire in + superclass selector functions. For instance, $p1(%,%) and $p2(%,%) are + the selectors for the binary constraint tuple. * In quite a lot of places things are restricted just to BoxedTuple/UnboxedTuple, and then we used BasicTypes.Boxity to distinguish @@ -914,26 +917,26 @@ mkConstraintTupleStr ar = "(%" ++ commas ar ++ "%)" commas :: Arity -> String commas ar = take (ar-1) (repeat ',') +cTupleTyCon :: Arity -> TyCon +cTupleTyCon i + | i > mAX_CTUPLE_SIZE = fstOf3 (mk_ctuple i) -- Build one specially + | otherwise = fstOf3 (cTupleArr ! i) + cTupleTyConName :: Arity -> Name -cTupleTyConName arity - = mkExternalName (mkCTupleTyConUnique arity) gHC_CLASSES - (mkCTupleOcc tcName arity) noSrcSpan +cTupleTyConName a = tyConName (cTupleTyCon a) cTupleTyConNames :: [Name] cTupleTyConNames = map cTupleTyConName (0 : [2..mAX_CTUPLE_SIZE]) -cTupleTyConNameSet :: NameSet -cTupleTyConNameSet = mkNameSet cTupleTyConNames +cTupleTyConKeys :: UniqSet Unique +cTupleTyConKeys = mkUniqSet $ map getUnique cTupleTyConNames isCTupleTyConName :: Name -> Bool --- Use Type.isCTupleClass where possible isCTupleTyConName n = ASSERT2( isExternalName n, ppr n ) - nameModule n == gHC_CLASSES - && n `elemNameSet` cTupleTyConNameSet + getUnique n `elementOfUniqSet` cTupleTyConKeys -- | If the given name is that of a constraint tuple, return its arity. --- Note that this is inefficient. cTupleTyConNameArity_maybe :: Name -> Maybe Arity cTupleTyConNameArity_maybe n | not (isCTupleTyConName n) = Nothing @@ -943,14 +946,46 @@ cTupleTyConNameArity_maybe n -- case, we have to adjust accordingly our calculated arity. adjustArity a = if a > 0 then a + 1 else a +cTupleDataCon :: Arity -> DataCon +cTupleDataCon i + | i > mAX_CTUPLE_SIZE = sndOf3 (mk_ctuple i) -- Build one specially + | otherwise = sndOf3 (cTupleArr ! i) + cTupleDataConName :: Arity -> Name -cTupleDataConName arity - = mkExternalName (mkCTupleDataConUnique arity) gHC_CLASSES - (mkCTupleOcc dataName arity) noSrcSpan +cTupleDataConName i = dataConName (cTupleDataCon i) cTupleDataConNames :: [Name] cTupleDataConNames = map cTupleDataConName (0 : [2..mAX_CTUPLE_SIZE]) +cTupleSelId :: ConTag -- Superclass position + -> Arity -- Arity + -> Id +cTupleSelId sc_pos arity + | sc_pos > arity + = panic ("cTupleSelId: index out of bounds: superclass position: " + ++ show sc_pos ++ " > arity " ++ show arity) + + | sc_pos <= 0 + = panic ("cTupleSelId: Superclass positions start from 1. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity < 2 + = panic ("cTupleSelId: Arity starts from 2. " + ++ "(superclass position: " ++ show sc_pos + ++ ", arity: " ++ show arity ++ ")") + + | arity > mAX_CTUPLE_SIZE + = thdOf3 (mk_ctuple arity) ! (sc_pos - 1) -- Build one specially + + | otherwise + = thdOf3 (cTupleArr ! arity) ! (sc_pos - 1) + +cTupleSelIdName :: ConTag -- Superclass position + -> Arity -- Arity + -> Name +cTupleSelIdName sc_pos arity = idName (cTupleSelId sc_pos arity) + tupleTyCon :: Boxity -> Arity -> TyCon tupleTyCon sort i | i > mAX_TUPLE_SIZE = fst (mk_tuple sort i) -- Build one specially tupleTyCon Boxed i = fst (boxedTupleArr ! i) @@ -976,6 +1011,20 @@ boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon) boxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]] unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]] +-- | Cached type constructors, data constructors, and superclass selectors for +-- constraint tuples. The outer array is indexed by the arity of the constraint +-- tuple and the inner array is indexed by the superclass position. +cTupleArr :: Array Int (TyCon, DataCon, Array Int Id) +cTupleArr = listArray (0,mAX_CTUPLE_SIZE) [mk_ctuple i | i <- [0..mAX_CTUPLE_SIZE]] + -- Although GHC does not make use of unary constraint tuples + -- (see Note [Ignore unary constraint tuples] in GHC.Tc.Gen.HsType), + -- this array creates one anyway. This is primarily motivated by the fact + -- that (1) the indices of an Array must be contiguous, and (2) we would like + -- the index of a constraint tuple in this Array to correspond to its Arity. + -- We could envision skipping over the unary constraint tuple and having index + -- 1 correspond to a 2-constraint tuple (and so on), but that's more + -- complicated than it's worth. + -- | Given the TupleRep/SumRep tycon and list of RuntimeReps of the unboxed -- tuple/sum arguments, produces the return kind of an unboxed tuple/sum type -- constructor. @unboxedTupleSumKind [IntRep, LiftedRep] --> TYPE (TupleRep/SumRep @@ -1040,6 +1089,45 @@ mk_tuple Unboxed arity = (tycon, tuple_con) tc_uniq = mkTupleTyConUnique boxity arity dc_uniq = mkTupleDataConUnique boxity arity +mk_ctuple :: Arity -> (TyCon, DataCon, Array ConTagZ Id) +mk_ctuple arity = (tycon, tuple_con, sc_sel_ids_arr) + where + tycon = mkClassTyCon tc_name binders roles + rhs klass + (mkPrelTyConRepName tc_name) + + klass = mk_ctuple_class tycon sc_theta sc_sel_ids + tuple_con = pcDataConW dc_name tvs (map unrestricted sc_theta) tycon + + binders = mkTemplateAnonTyConBinders (replicate arity constraintKind) + roles = replicate arity Nominal + rhs = TupleTyCon{data_con = tuple_con, tup_sort = ConstraintTuple} + + modu = gHC_CLASSES + tc_name = mkWiredInName modu (mkCTupleOcc tcName arity) tc_uniq + (ATyCon tycon) BuiltInSyntax + dc_name = mkWiredInName modu (mkCTupleOcc dataName arity) dc_uniq + (AConLike (RealDataCon tuple_con)) BuiltInSyntax + tc_uniq = mkCTupleTyConUnique arity + dc_uniq = mkCTupleDataConUnique arity + + tvs = binderVars binders + sc_theta = map mkTyVarTy tvs + sc_sel_ids = [mk_sc_sel_id sc_pos | sc_pos <- [0..arity-1]] + sc_sel_ids_arr = listArray (0,arity-1) sc_sel_ids + + mk_sc_sel_id sc_pos = + let sc_sel_id_uniq = mkCTupleSelIdUnique sc_pos arity + sc_sel_id_occ = mkCTupleOcc tcName arity + sc_sel_id_name = mkWiredInIdName + gHC_CLASSES + (occNameFS (mkSuperDictSelOcc sc_pos sc_sel_id_occ)) + sc_sel_id_uniq + sc_sel_id + sc_sel_id = mkDictSelId sc_sel_id_name klass + + in sc_sel_id + unitTyCon :: TyCon unitTyCon = tupleTyCon Boxed 0 @@ -1248,7 +1336,10 @@ mk_class tycon sc_pred sc_sel_id = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon - +mk_ctuple_class :: TyCon -> ThetaType -> [Id] -> Class +mk_ctuple_class tycon sc_theta sc_sel_ids + = mkClass (tyConName tycon) (tyConTyVars tycon) [] sc_theta sc_sel_ids + [] [] (mkAnd []) tycon {- ********************************************************************* * * ===================================== compiler/GHC/Builtin/Types.hs-boot ===================================== @@ -64,8 +64,10 @@ promotedTupleDataCon :: Boxity -> Arity -> TyCon tupleDataCon :: Boxity -> Arity -> DataCon tupleTyCon :: Boxity -> Arity -> TyCon +cTupleDataCon :: Arity -> DataCon cTupleDataConName :: Arity -> Name cTupleTyConName :: Arity -> Name +cTupleSelIdName :: ConTag -> Arity -> Name sumDataCon :: ConTag -> Arity -> DataCon sumTyCon :: Arity -> TyCon ===================================== compiler/GHC/Builtin/Uniques.hs ===================================== @@ -22,6 +22,7 @@ module GHC.Builtin.Uniques -- *** Constraint , mkCTupleTyConUnique , mkCTupleDataConUnique + , mkCTupleSelIdUnique -- ** Making built-in uniques , mkAlphaTyVarUnique @@ -79,34 +80,37 @@ knownUniqueName u = '5' -> Just $ getTupleTyConName Unboxed n '7' -> Just $ getTupleDataConName Boxed n '8' -> Just $ getTupleDataConName Unboxed n + 'j' -> Just $ getCTupleSelIdName n 'k' -> Just $ getCTupleTyConName n - 'm' -> Just $ getCTupleDataConUnique n + 'm' -> Just $ getCTupleDataConName n _ -> Nothing where (tag, n) = unpkUnique u --------------------------------------------------- --- Anonymous sums --- --- Sum arities start from 2. The encoding is a bit funny: we break up the --- integral part into bitfields for the arity, an alternative index (which is --- taken to be 0xff in the case of the TyCon), and, in the case of a datacon, a --- tag (used to identify the sum's TypeRep binding). --- --- This layout is chosen to remain compatible with the usual unique allocation --- for wired-in data constructors described in GHC.Types.Unique --- --- TyCon for sum of arity k: --- 00000000 kkkkkkkk 11111100 +{- +Note [Unique layout for unboxed sums] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- TypeRep of TyCon for sum of arity k: --- 00000000 kkkkkkkk 11111101 --- --- DataCon for sum of arity k and alternative n (zero-based): --- 00000000 kkkkkkkk nnnnnn00 --- --- TypeRep for sum DataCon of arity k and alternative n (zero-based): --- 00000000 kkkkkkkk nnnnnn10 +Sum arities start from 2. The encoding is a bit funny: we break up the +integral part into bitfields for the arity, an alternative index (which is +taken to be 0xfc in the case of the TyCon), and, in the case of a datacon, a +tag (used to identify the sum's TypeRep binding). + +This layout is chosen to remain compatible with the usual unique allocation +for wired-in data constructors described in GHC.Types.Unique + +TyCon for sum of arity k: + 00000000 kkkkkkkk 11111100 + +TypeRep of TyCon for sum of arity k: + 00000000 kkkkkkkk 11111101 + +DataCon for sum of arity k and alternative n (zero-based): + 00000000 kkkkkkkk nnnnnn00 + +TypeRep for sum DataCon of arity k and alternative n (zero-based): + 00000000 kkkkkkkk nnnnnn10 +-} mkSumTyConUnique :: Arity -> Unique mkSumTyConUnique arity = @@ -156,8 +160,56 @@ getUnboxedSumName n -- * u+1: its worker Id -- * u+2: the TyConRepName of the promoted TyCon --------------------------------------------------- --- Constraint tuples +{- +Note [Unique layout for constraint tuple selectors] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Constraint tuples, like boxed and unboxed tuples, have their type and data +constructor Uniques wired in (see +Note [Uniques for tuple type and data constructors]). Constraint tuples are +somewhat more involved, however. For a boxed or unboxed n-tuple, we need: + +* A Unique for the type constructor, and +* A Unique for the data constructor + +With a constraint n-tuple, however, we need: + +* A Unique for the type constructor, +* A Unique for the data constructor, and +* A Unique for each of the n superclass selectors + +To pick a concrete example (n = 2), the binary constraint tuple has a type +constructor and data constructor (%,%) along with superclass selectors +$p1(%,%) and $p2(%,%). + +Just as we wire in the Uniques for constraint tuple type constructors and data +constructors, we wish to wire in the Uniques for the superclass selectors as +well. Not only does this make everything consistent, it also avoids a +compile-time performance penalty whenever GHC.Classes is loaded from an +interface file. This is because GHC.Classes defines constraint tuples as class +definitions, and if these classes weren't wired in, then loading GHC.Classes +would also load every single constraint tuple type constructor, data +constructor, and superclass selector. See #18635. + +We encode the Uniques for constraint tuple superclass selectors as follows. The +integral part of the Unique is broken up into bitfields for the arity and the +position of the superclass. Given a selector for a constraint tuple with +arity n (zero-based) and position k (where 1 <= k <= n), its Unique will look +like: + + 00000000 nnnnnnnn kkkkkkkk + +We can use bit-twiddling tricks to access the arity and position with +cTupleSelIdArityBits and cTupleSelIdPosBitmask, respectively. + +This pattern bears a certain resemblance to the way that the Uniques for +unboxed sums are encoded. This is because for a unboxed sum of arity n, there +are n corresponding data constructors, each with an alternative position k. +Similarly, for a constraint tuple of arity n, there are n corresponding +superclass selectors. Reading Note [Unique layout for unboxed sums] will +instill an appreciation for how the encoding for constraint tuple superclass +selector Uniques takes inspiration from the encoding for unboxed sum Uniques. +-} mkCTupleTyConUnique :: Arity -> Unique mkCTupleTyConUnique a = mkUnique 'k' (2*a) @@ -165,6 +217,13 @@ mkCTupleTyConUnique a = mkUnique 'k' (2*a) mkCTupleDataConUnique :: Arity -> Unique mkCTupleDataConUnique a = mkUnique 'm' (3*a) +mkCTupleSelIdUnique :: ConTagZ -> Arity -> Unique +mkCTupleSelIdUnique sc_pos arity + | sc_pos >= arity + = panic ("mkCTupleSelIdUnique: " ++ show sc_pos ++ " >= " ++ show arity) + | otherwise + = mkUnique 'j' (arity `shiftL` cTupleSelIdArityBits + sc_pos) + getCTupleTyConName :: Int -> Name getCTupleTyConName n = case n `divMod` 2 of @@ -172,14 +231,36 @@ getCTupleTyConName n = (arity, 1) -> mkPrelTyConRepName $ cTupleTyConName arity _ -> panic "getCTupleTyConName: impossible" -getCTupleDataConUnique :: Int -> Name -getCTupleDataConUnique n = +getCTupleDataConName :: Int -> Name +getCTupleDataConName n = case n `divMod` 3 of (arity, 0) -> cTupleDataConName arity - (_arity, 1) -> panic "getCTupleDataConName: no worker" + (arity, 1) -> getName $ dataConWrapId $ cTupleDataCon arity (arity, 2) -> mkPrelTyConRepName $ cTupleDataConName arity _ -> panic "getCTupleDataConName: impossible" +getCTupleSelIdName :: Int -> Name +getCTupleSelIdName n = cTupleSelIdName (sc_pos + 1) arity + where + arity = n `shiftR` cTupleSelIdArityBits + sc_pos = n .&. cTupleSelIdPosBitmask + +-- Given the arity of a constraint tuple, this is the number of bits by which +-- one must shift it to the left in order to encode the arity in the Unique +-- of a superclass selector for that constraint tuple. Alternatively, given the +-- Unique for a constraint tuple superclass selector, this is the number of +-- bits by which one must shift it to the right to retrieve the arity of the +-- constraint tuple. See Note [Unique layout for constraint tuple selectors]. +cTupleSelIdArityBits :: Int +cTupleSelIdArityBits = 8 + +-- Given the Unique for a constraint tuple superclass selector, one can +-- retrieve the position of the selector by ANDing this mask, which will +-- clear all but the eight least significant bits. +-- See Note [Unique layout for constraint tuple selectors]. +cTupleSelIdPosBitmask :: Int +cTupleSelIdPosBitmask = 0xff + -------------------------------------------------- -- Normal tuples @@ -230,6 +311,7 @@ Allocation of unique supply characters: d desugarer f AbsC flattener g SimplStg + j constraint tuple superclass selectors k constraint tuple tycons m constraint tuple datacons n Native codegen ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -1203,10 +1203,9 @@ tcTupleTyCon :: Bool -- True <=> typechecking a *type* (vs. an expr) -> IfL TyCon tcTupleTyCon in_type sort arity = case sort of - ConstraintTuple -> do { thing <- tcIfaceGlobal (cTupleTyConName arity) - ; return (tyThingTyCon thing) } - BoxedTuple -> return (tupleTyCon Boxed arity) - UnboxedTuple -> return (tupleTyCon Unboxed arity') + ConstraintTuple -> return (cTupleTyCon arity) + BoxedTuple -> return (tupleTyCon Boxed arity) + UnboxedTuple -> return (tupleTyCon Unboxed arity') where arity' | in_type = arity `div` 2 | otherwise = arity -- in expressions, we only have term args ===================================== compiler/GHC/Tc/Gen/HsType.hs ===================================== @@ -1269,8 +1269,8 @@ finish_tuple rn_ty tup_sort tau_tys tau_kinds exp_kind = do | arity > mAX_CTUPLE_SIZE -> failWith (bigConstraintTuple arity) | otherwise - -> do tycon <- tcLookupTyCon (cTupleTyConName arity) - check_expected_kind (mkTyConApp tycon tau_tys) constraintKind + -> let tycon = cTupleTyCon arity in + check_expected_kind (mkTyConApp tycon tau_tys) constraintKind BoxedTuple -> do let tycon = tupleTyCon Boxed arity checkWiredInTyCon tycon ===================================== compiler/GHC/Types/Basic.hs ===================================== @@ -179,7 +179,7 @@ type JoinArity = Int ************************************************************************ -} --- | Constructor Tag +-- | A *one-index* constructor tag -- -- Type of the tags associated with each constructor possibility or superclass -- selector ===================================== testsuite/driver/perf_notes.py ===================================== @@ -113,7 +113,13 @@ MetricOracles = NamedTuple("MetricOracles", [("baseline", MetricBaselineOracle), def parse_perf_stat(stat_str: str) -> PerfStat: field_vals = stat_str.strip('\t').split('\t') - return PerfStat(*field_vals) # type: ignore + stat = PerfStat(*field_vals) # type: ignore + if stat.test_env.startswith('"') and stat.test_env.endswith('"'): + # Due to a bug, in historical data sometimes the test_env + # contains additional quotation marks (#18656). + # Remove them, so that we can refer to past data in a uniform fashion. + stat = stat._replace(test_env=TestEnv(stat.test_env[1:-1])) + return stat # Get all recorded (in a git note) metrics for a given commit. # Returns an empty array if the note is not found. @@ -645,6 +651,8 @@ def main() -> None: metrics = [test for test in metrics if test.stat.way == args.way] if args.test_env: + if '"' in args.test_env: + raise Exception('test_env should not contain quotation marks') metrics = [test for test in metrics if test.stat.test_env == args.test_env] if args.test_name: View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ede82d8e6cbea05acf7a06a1845c30efc8a14c2d...840ec0435f9e117dd56de4fde74af1434b527891 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ede82d8e6cbea05acf7a06a1845c30efc8a14c2d...840ec0435f9e117dd56de4fde74af1434b527891 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 00:49:53 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Mon, 07 Sep 2020 20:49:53 -0400 Subject: [Git][ghc/ghc][wip/T18599] Don't use parser monad in fbinds Message-ID: <5f56d5318ccb5_80b3f84399e643c10969352@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: 6b893ad5 by Shayne Fletcher at 2020-09-07T20:49:37-04:00 Don't use parser monad in fbinds - - - - - 1 changed file: - compiler/GHC/Parser.y Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -2717,12 +2717,13 @@ aexp :: { ECP } | aexp1 { $1 } aexp1 :: { ECP } - : aexp1 '{' fbinds '}' { ECP $ - getBit RecordDotSyntaxBit >>= \ dot -> - unECP $1 >>= \ $1 -> - $3 >>= \ $3 -> - amms (mkHsRecordPV dot (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3)) - (moc $2:mcc $4:(fst $3)) } + : aexp1 '{' fbinds '}' {% getBit RecordDotSyntaxBit >>= \ dot -> + return (ECP $ + unECP $1 >>= \ $1 -> + $3 >>= \ $3 -> + amms (mkHsRecordPV dot (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3)) + (moc $2:mcc $4:(fst $3)) + ) } | aexp2 { $1 } aexp2 :: { ECP } @@ -3239,8 +3240,7 @@ fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([Fbind b], Maybe SrcSpan)) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> return $ Fbind (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False) - -- ams (Fbind (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)) - -- [mj AnnEqual $2] + -- ams (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False) [mj AnnEqual $2] } -- RHS is a 'texp', allowing view patterns (#6038) -- and, incidentally, sections. Eg @@ -3255,26 +3255,16 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- See Note [Whitespace-sensitive operator parsing] in Lexer.x | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp { unECP $5 >>= \ $5 -> - mkHsFieldUpdaterPV ($1 : reverse $3) $5 >>= \ up -> - return $ Pbind up + fmap Pbind $ mkHsFieldUpdaterPV ($1 : reverse $3) $5 } -- See Note [Whitespace-sensitive operator parsing] in Lexer.x | field TIGHT_INFIX_PROJ fieldToUpdate { let { ; top = $1 ; fields = top : reverse $3 - ; final = last fields } - in - getBit RecordPunsBit >>= \ puns -> - if puns - then - let arg = mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final in - mkHsVarPV (noLoc arg) >>= \ var -> - mkHsFieldUpdaterPV fields var >>= \ up -> - return $ Pbind up - else - addFatalError noSrcSpan $ - text "For this to work, enable NamedFieldPuns." + ; final = last fields } in + mkHsVarPV (noLoc (mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final)) >>= \ var -> + fmap Pbind (mkHsFieldUpdaterPV fields var) } fieldToUpdate :: { [Located FastString] } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b893ad5175633aab14388c2e9b30e17ddc1a116 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6b893ad5175633aab14388c2e9b30e17ddc1a116 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 01:18:46 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 07 Sep 2020 21:18:46 -0400 Subject: [Git][ghc/ghc][master] [macOS] improved runpath handling Message-ID: <5f56dbf66b8e1_80b3f84399e643c109721be@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - 16 changed files: - aclocal.m4 - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - docs/users_guide/phases.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - mk/config.mk.in - testsuite/tests/rts/all.T Changes: ===================================== aclocal.m4 ===================================== @@ -602,6 +602,18 @@ AC_DEFUN([FP_SETTINGS], else SettingsOptCommand="$OptCmd" fi + if test -z "$OtoolCmd" + then + SettingsOtoolCommand="otool" + else + SettingsOtoolCommand="$OtoolCmd" + fi + if test -z "$InstallNameToolCmd" + then + SettingsInstallNameToolCommand="install_name_tool" + else + SettingsInstallNameToolCommand="$InstallNameToolCmd" + fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -621,6 +633,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -394,7 +394,56 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commands. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc's ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1787,9 +1836,12 @@ linkBinary' staticLink dflags o_files dep_units = do rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then GHC.SysTools.runLibtool - else GHC.SysTools.runLink + let link dflags args | staticLink = GHC.SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = GHC.SysTools.runLink dflags args >> GHC.SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = GHC.SysTools.runLink dflags args + link dflags ( map GHC.SysTools.Option verbFlags ++ [ GHC.SysTools.Option "-o" @@ -1856,7 +1908,13 @@ linkBinary' staticLink dflags o_files dep_units = do ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -145,8 +145,8 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, + pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool, + pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -885,6 +885,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags +pgm_otool :: DynFlags -> String +pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) @@ -2267,6 +2271,10 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } + , make_ord_flag defFlag "pgmotool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f} + , make_ord_flag defFlag "pgminstall_name_tool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f} , make_ord_flag defFlag "pgmranlib" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } @@ -3780,7 +3788,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -3791,6 +3798,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -3831,6 +3840,29 @@ default_PIC platform = -- information. _ -> [] + +-- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS +-- versions the number of load commands we can embed in a dynamic library is +-- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only +-- link the needed dylibs instead of linking the full dependency closure. +-- +-- If we split the library linking into injecting -rpath and -l @rpath/... +-- components, we will reduce the number of libraries we link, however we will +-- still inject one -rpath entry for each library, independent of their use. +-- That is, we even inject -rpath values for libraries that we dead_strip in +-- the end. As such we can run afoul of the load command size limit simply +-- by polluting the load commands with RPATH entries. +-- +-- Thus, we disable Opt_RPath by default on OSDarwin. The savvy user can always +-- enable it with -use-rpath if they so wish. +-- +-- See Note [Dynamic linking on macOS] + +default_RPath :: Platform -> [GeneralFlag] +default_RPath platform | platformOS platform == OSDarwin = [] +default_RPath _ = [Opt_RPath] + + -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -929,20 +929,22 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,6 +34,8 @@ module GHC.Settings , sPgm_windres , sPgm_libtool , sPgm_ar + , sPgm_otool + , sPgm_install_name_tool , sPgm_ranlib , sPgm_lo , sPgm_lc @@ -107,6 +109,8 @@ data ToolSettings = ToolSettings , toolSettings_pgm_windres :: String , toolSettings_pgm_libtool :: String , toolSettings_pgm_ar :: String + , toolSettings_pgm_otool :: String + , toolSettings_pgm_install_name_tool :: String , toolSettings_pgm_ranlib :: String , -- | LLVM: opt llvm optimiser toolSettings_pgm_lo :: (String, [Option]) @@ -216,6 +220,10 @@ sPgm_libtool :: Settings -> String sPgm_libtool = toolSettings_pgm_libtool . sToolSettings sPgm_ar :: Settings -> String sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_otool :: Settings -> String +sPgm_otool = toolSettings_pgm_otool . sToolSettings +sPgm_install_name_tool :: Settings -> String +sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings sPgm_ranlib :: Settings -> String sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings sPgm_lo :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -115,6 +115,8 @@ initSettings top_dir = do windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -191,6 +193,8 @@ initSettings top_dir = do , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) ===================================== compiler/GHC/SysTools.hs ===================================== @@ -261,7 +261,10 @@ linkDynLib dflags0 o_files dep_packages | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `Set.member` ways dflags + -- Only if we want dynamic libraries + WayDyn `Set.member` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -386,8 +389,15 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the leftover + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -28,6 +28,10 @@ import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pa import GHC.SysTools.Process import GHC.SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,41 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included in the load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of libraries end up being truely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath at . +-- +-- See Note [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + -- find any pre-existing LC_PATH items + info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib] + let paths = concatMap f info + where f ("path":p:_) = [p] + f _ = [] + lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ] + -- only find those rpaths, that aren't already in the library. + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths') + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -329,6 +368,17 @@ runAr dflags cwd args = traceToolCommand dflags "ar" $ do let ar = pgm_ar dflags runSomethingFiltered dflags id "Ar" ar args cwd Nothing +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing + runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do let ranlib = pgm_ranlib dflags ===================================== configure.ac ===================================== @@ -699,6 +699,18 @@ else fi AC_SUBST([LibtoolCmd]) +dnl ** Which otool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([OTOOL], [otool]) +OtoolCmd="$OTOOL" +AC_SUBST(OtoolCmd) + +dnl ** Which install_name_tool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool]) +InstallNameToolCmd="$INSTALL_NAME_TOOL" +AC_SUBST(InstallNameToolCmd) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -1522,6 +1534,8 @@ echo "\ libtool : $LibtoolCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd + otool : $OtoolCmd + install_name_tool : $InstallNameToolCmd windres : $WindresCmd dllwrap : $DllWrapCmd genlib : $GenlibCmd ===================================== docs/users_guide/phases.rst ===================================== @@ -95,6 +95,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only). +.. ghc-flag:: -pgmotool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inspect mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and + executables to read the dynamic library dependencies. We will compute + the necessary ``runpath``s to embed for the dependencies based on the + result of the ``otool`` call. + +.. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inject ``runpath`` into mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inject ``runpath``s into mach-o dynamic + libraries and executables. As detected by the ``otool`` call. + .. ghc-flag:: -pgmwindres ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the program for embedding manifests on Windows. :type: dynamic ===================================== hadrian/cfg/system.config.in ===================================== @@ -152,6 +152,8 @@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ +settings-otool-command = @SettingsOtoolCommand@ +settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-libtool-command = @SettingsLibtoolCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -114,6 +114,8 @@ data SettingsFileSetting | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_OtoolCommand + | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_LibtoolCommand @@ -200,6 +202,8 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_OtoolCommand -> "settings-otool-command" + SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -308,6 +308,8 @@ generateSettings = do , ("ar flags", expr $ lookupValueOrError configFile "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) ===================================== includes/ghc.mk ===================================== @@ -233,6 +233,8 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ + @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -504,6 +504,8 @@ SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ ===================================== testsuite/tests/rts/all.T ===================================== @@ -406,7 +406,7 @@ test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp - test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug']) test('T13676', - [when(opsys('darwin') or opsys('mingw32'), expect_broken(17447)), + [when(opsys('mingw32'), expect_broken(17447)), extra_files(['T13676.hs'])], ghci_script, ['T13676.script']) test('InitEventLogging', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ff93292243888545da452ea4d4c1987f2343591 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4ff93292243888545da452ea4d4c1987f2343591 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 01:19:26 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 07 Sep 2020 21:19:26 -0400 Subject: [Git][ghc/ghc][master] Move DynFlags test into updateModDetailsIdInfos's caller (#17957) Message-ID: <5f56dc1e5e143_80b3f8429a578cc109756b8@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - 2 changed files: - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Iface/UpdateIdInfos.hs Changes: ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -1237,8 +1237,11 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do hscGenHardCode hsc_env' cgguts mod_location output_fn final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just cg_infos)) - let final_mod_details = {-# SCC updateModDetailsIdInfos #-} - updateModDetailsIdInfos iface_dflags cg_infos mod_details + let final_mod_details + | gopt Opt_OmitInterfacePragmas iface_dflags + = mod_details + | otherwise = {-# SCC updateModDetailsIdInfos #-} + updateModDetailsIdInfos cg_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] ===================================== compiler/GHC/Iface/UpdateIdInfos.hs ===================================== @@ -8,7 +8,6 @@ import GHC.Prelude import GHC.Core import GHC.Core.InstEnv -import GHC.Driver.Session import GHC.Driver.Types import GHC.StgToCmm.Types (CgInfos (..)) import GHC.Types.Id @@ -28,16 +27,11 @@ import GHC.Utils.Panic -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types. updateModDetailsIdInfos - :: DynFlags - -> CgInfos + :: CgInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsIdInfos dflags _ mod_details - | gopt Opt_OmitInterfacePragmas dflags - = mod_details - -updateModDetailsIdInfos _ cg_infos mod_details = +updateModDetailsIdInfos cg_infos mod_details = let ModDetails{ md_types = type_env -- for unfoldings , md_insts = insts View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df04b81e12dac85292aa18c07e6afac7a8bd2fd5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/df04b81e12dac85292aa18c07e6afac7a8bd2fd5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 01:58:34 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 21:58:34 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 3 commits: gitlab-ci: Bump Docker images Message-ID: <5f56e54af041d_80b107c77b0109802ba@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 333a69b7 by Ben Gamari at 2020-09-07T21:58:27-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 5417f208 by Ben Gamari at 2020-09-07T21:58:27-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - cdb6dd1b by Ben Gamari at 2020-09-07T21:58:27-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 8 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - testsuite/tests/module/mod184.stderr - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: e1cdfaea745989faa266f09c1d6c4c981aa34dc6 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10: + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: @@ -1078,8 +1078,8 @@ perf-nofib: make install popd rm -Rf tmp - - export BOOT_HC=$(which ghc) - - cabal update; cabal install -w $BOOT_HC regex-compat + - export BOOT_HC=$GHC + - cabal update; cabal install -w "$BOOT_HC" regex-compat - export PATH=$root/bin:$PATH - make -C nofib boot mode=fast -j$CPUS - "make -C nofib EXTRA_RUNTEST_OPTS='-cachegrind +RTS -V0 -RTS' NoFibRuns=1 mode=fast -j$CPUS 2>&1 | tee nofib.log" ===================================== .gitlab/ci.sh ===================================== @@ -143,22 +143,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -195,12 +199,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -224,12 +228,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -270,7 +274,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -1,3 +1,4 @@ + mod184.hs:6:8: warning: [-Wprepositive-qualified-module] Found ‘qualified’ in prepositive position Suggested fix: place ‘qualified’ after the module name instead. ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f14fc9931597bc69e3dc9985eb567a0e871be9f7...cdb6dd1bfe46562e73a9f9d775c9cf932a58c48c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f14fc9931597bc69e3dc9985eb567a0e871be9f7...cdb6dd1bfe46562e73a9f9d775c9cf932a58c48c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 02:02:16 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 22:02:16 -0400 Subject: [Git][ghc/ghc][wip/bump-ci-images] 3 commits: gitlab-ci: Bump Docker images Message-ID: <5f56e628e2420_80bd79662c109806ce@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-ci-images at Glasgow Haskell Compiler / GHC Commits: 870bc80b by Ben Gamari at 2020-09-07T22:02:11-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - a06629ae by Ben Gamari at 2020-09-07T22:02:11-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 17c60ca8 by Ben Gamari at 2020-09-07T22:02:11-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 8 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - testsuite/tests/module/mod184.stderr - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: e1cdfaea745989faa266f09c1d6c4c981aa34dc6 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10: + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: @@ -1078,8 +1078,8 @@ perf-nofib: make install popd rm -Rf tmp - - export BOOT_HC=$(which ghc) - - cabal update; cabal install -w $BOOT_HC regex-compat + - export BOOT_HC=$GHC + - cabal update; cabal install -w "$BOOT_HC" --lib regex-compat - export PATH=$root/bin:$PATH - make -C nofib boot mode=fast -j$CPUS - "make -C nofib EXTRA_RUNTEST_OPTS='-cachegrind +RTS -V0 -RTS' NoFibRuns=1 mode=fast -j$CPUS 2>&1 | tee nofib.log" ===================================== .gitlab/ci.sh ===================================== @@ -143,22 +143,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -195,12 +199,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -224,12 +228,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -270,7 +274,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -1,3 +1,4 @@ + mod184.hs:6:8: warning: [-Wprepositive-qualified-module] Found ‘qualified’ in prepositive position Suggested fix: place ‘qualified’ after the module name instead. ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cdb6dd1bfe46562e73a9f9d775c9cf932a58c48c...17c60ca87dc43e988aef0fc68aac75f7670c4acb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cdb6dd1bfe46562e73a9f9d775c9cf932a58c48c...17c60ca87dc43e988aef0fc68aac75f7670c4acb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 02:26:33 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 22:26:33 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports2 Message-ID: <5f56ebd948be2_80b3f8458852ea8109824a8@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/backports2 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 02:26:35 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Mon, 07 Sep 2020 22:26:35 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 3 commits: testsuite: Only run llvm ways if llc is available Message-ID: <5f56ebdb4d199_80b3f84070bc6cc109826a4@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: c2030f00 by Ben Gamari at 2020-09-07T16:16:05-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. (cherry picked from commit aa4b744d51aa6bdb46064f981ea8e001627921d6) - - - - - 6dbd1054 by Sylvain Henry at 2020-09-07T16:20:38-04:00 Remove outdated note - - - - - c23275f4 by Sylvain Henry at 2020-09-07T16:20:38-04:00 Bignum: add missing compat import/export functions - - - - - 6 changed files: - compiler/GHC/Builtin/Names.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs - testsuite/config/ghc - testsuite/driver/testglobals.py - testsuite/mk/test.mk Changes: ===================================== compiler/GHC/Builtin/Names.hs ===================================== @@ -116,35 +116,6 @@ known keys. See Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys) in GHC.Builtin.Types. -Note [The integer library] -~~~~~~~~~~~~~~~~~~~~~~~~~~ - -Clearly, we need to know the names of various definitions of the integer -library, e.g. the type itself, `mkInteger` etc. But there are two possible -implementations of the integer library: - - * integer-gmp (fast, but uses libgmp, which may not be available on all - targets and is GPL licensed) - * integer-simple (slow, but pure Haskell and BSD-licensed) - -We want the compiler to work with either one. The way we achieve this is: - - * When compiling the integer-{gmp,simple} library, we pass - -this-unit-id integer-wired-in - to GHC (see the cabal file libraries/integer-{gmp,simple}. - * This way, GHC can use just this UnitID (see Module.integerUnitId) when - generating code, and the linker will succeed. - -Unfortuately, the abstraction is not complete: When using integer-gmp, we -really want to use the S# constructor directly. This is controlled by -the `integerLibrary` field of `DynFlags`: If it is IntegerGMP, we use -this constructor directly (see CorePrep.lookupIntegerSDataConName) - -When GHC reads the package data base, it (internally only) pretends it has UnitId -`integer-wired-in` instead of the actual UnitId (which includes the version -number); just like for `base` and other packages, as described in -Note [Wired-in units] in GHC.Unit.Module. This is done in -GHC.Unit.State.findWiredInUnits. -} {-# LANGUAGE CPP #-} ===================================== hadrian/src/Settings/Builders/RunTest.hs ===================================== @@ -70,7 +70,6 @@ runTestBuilderArgs = builder RunTest ? do withSMP <- getBooleanSetting TestGhcWithSMP debugged <- getBooleanSetting TestGhcDebugged keepFiles <- expr (testKeepFiles <$> userSetting defaultTestArgs) - withLlvm <- expr (not . null <$> settingsFileSetting SettingsFileSetting_LlcCommand) accept <- expr (testAccept <$> userSetting defaultTestArgs) (acceptPlatform, acceptOS) <- expr . liftIO $ @@ -126,8 +125,6 @@ runTestBuilderArgs = builder RunTest ? do , arg "-e", arg $ asBool "config.have_profiling=" (hasLibWay profiling) , arg "-e", arg $ asBool "config.have_fast_bignum=" (bignumBackend /= "native" && not bignumCheck) , arg "-e", arg $ asBool "ghc_with_smp=" withSMP - , arg "-e", arg $ asBool "ghc_with_llvm=" withLlvm - , arg "-e", arg $ "config.ghc_dynamic_by_default=" ++ show hasDynamicByDefault , arg "-e", arg $ "config.ghc_dynamic=" ++ show hasDynamic ===================================== libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs ===================================== @@ -57,9 +57,6 @@ module GHC.Integer.GMP.Internals , bigNatToInt , bigNatToWord , indexBigNat# - , importBigNatFromByteArray - , exportBigNatToMutableByteArray - -- ** 'BigNat' arithmetic operations , plusBigNat @@ -112,9 +109,17 @@ module GHC.Integer.GMP.Internals -- ** Export , exportBigNatToAddr + , exportIntegerToAddr + + , exportBigNatToMutableByteArray + , exportIntegerToMutableByteArray -- ** Import , importBigNatFromAddr + , importIntegerFromAddr + + , importBigNatFromByteArray + , importIntegerFromByteArray ) where import GHC.Integer @@ -373,6 +378,18 @@ exportBigNatToAddr (BN# b) addr endian = IO \s -> case B.bigNatToAddr# b addr endian s of (# s', w #) -> (# s', W# w #) +{-# DEPRECATED importIntegerFromAddr "Use integerFromAddr# instead" #-} +importIntegerFromAddr :: Addr# -> Word# -> Int# -> IO Integer +importIntegerFromAddr addr sz endian = IO \s -> + case I.integerFromAddr# sz addr endian s of + (# s', i #) -> (# s', i #) + +{-# DEPRECATED exportIntegerToAddr "Use integerToAddr# instead" #-} +exportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word +exportIntegerToAddr i addr endian = IO \s -> + case I.integerToAddr# i addr endian s of + (# s', w #) -> (# s', W# w #) + wordToBigNat :: Word# -> BigNat wordToBigNat w = BN# (B.bigNatFromWord# w) @@ -398,3 +415,13 @@ importBigNatFromByteArray ba off sz endian = case runRW# (B.bigNatFromByteArray# exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word exportBigNatToMutableByteArray (BN# ba) mba off endian = IO (\s -> case B.bigNatToMutableByteArray# ba mba off endian s of (# s', r #) -> (# s', W# r #)) + +{-# DEPRECATED importIntegerFromByteArray "Use integerFromByteArray# instead" #-} +importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer +importIntegerFromByteArray ba off sz endian = case runRW# (I.integerFromByteArray# sz ba off endian) of + (# _, r #) -> r + +{-# DEPRECATED exportIntegerToMutableByteArray "Use integerToMutableByteArray# instead" #-} +exportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Int# -> IO Word +exportIntegerToMutableByteArray i mba off endian = IO (\s -> case I.integerToMutableByteArray# i mba off endian s of + (# s', r #) -> (# s', W# r #)) ===================================== testsuite/config/ghc ===================================== @@ -64,10 +64,6 @@ else: if (config.have_profiling and ghc_with_threaded_rts): config.run_ways.append('profthreaded') -if (ghc_with_llvm and not config.unregisterised): - config.compile_ways.append('optllvm') - config.run_ways.append('optllvm') - # WinIO I/O manager for Windows if windows: winio_ways = ['winio', 'winio_threaded'] @@ -195,6 +191,17 @@ def get_compiler_info(): config.have_ncg = compilerInfoDict.get("Have native code generator", "NO") == "YES" + # Detect whether an LLVM toolhain is available + llc_path = compilerInfoDict.get("LLVM llc command") + config.have_llvm = shutil.which(llc_path) is not None + if config.unregisterised: + print("Unregisterised build; skipping LLVM ways...") + elif config.have_llvm: + config.compile_ways.append('optllvm') + config.run_ways.append('optllvm') + else: + print("Failed to find `llc` command; skipping LLVM ways...") + # Whether GHC itself was built using the LLVM backend. We need to know this # since some tests in ext-interp fail when stage2 ghc is built using # LLVM. See #16087. ===================================== testsuite/driver/testglobals.py ===================================== @@ -115,6 +115,9 @@ class TestConfig: self.way_flags = {} # type: Dict[WayName, List[str]] self.way_rts_flags = {} # type: Dict[WayName, List[str]] + # Do we have a functional LLVM toolchain? + self.have_llvm = False + # Do we have vanilla libraries? self.have_vanilla = False ===================================== testsuite/mk/test.mk ===================================== @@ -188,18 +188,6 @@ else RUNTEST_OPTS += -e ghc_with_smp=False endif -# Does the LLVM backend work? -ifeq "$(LLC)" "" -RUNTEST_OPTS += -e ghc_with_llvm=False -else ifeq "$(TargetARCH_CPP)" "powerpc" -RUNTEST_OPTS += -e ghc_with_llvm=False -else ifneq "$(LLC)" "llc" -# If we have a real detected value for LLVM, then it really ought to work -RUNTEST_OPTS += -e ghc_with_llvm=True -else -RUNTEST_OPTS += -e ghc_with_llvm=False -endif - ifeq "$(WINDOWS)" "YES" RUNTEST_OPTS += -e windows=True else View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cee137dcab0b33915b0add69db9535ef4227f824...c23275f4dd8999c673da1b9458c68e768e1f72a6 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cee137dcab0b33915b0add69db9535ef4227f824...c23275f4dd8999c673da1b9458c68e768e1f72a6 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 02:51:09 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Mon, 07 Sep 2020 22:51:09 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: [macOS] improved runpath handling Message-ID: <5f56f19d2434b_80b3f8459839ee8109872d4@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - 9c23e2d6 by Daishi Nakajima at 2020-09-07T22:51:01-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - c86e667a by Ben Gamari at 2020-09-07T22:51:01-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - 86120f70 by Ben Gamari at 2020-09-07T22:51:01-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - 21 changed files: - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Iface/UpdateIdInfos.hs - compiler/GHC/Runtime/Linker.hs - compiler/GHC/Settings.hs - compiler/GHC/Settings/IO.hs - compiler/GHC/SysTools.hs - compiler/GHC/SysTools/Tasks.hs - configure.ac - docs/users_guide/phases.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - mk/config.mk.in - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - testsuite/driver/testutil.py - testsuite/tests/rts/all.T Changes: ===================================== .gitlab/ci.sh ===================================== @@ -58,6 +58,12 @@ function run() { TOP="$(pwd)" function setup_locale() { + # Musl doesn't provide locale support at all... + if ! which locale > /dev/null; then + info "No locale executable. Skipping locale setup..." + return + fi + # BSD grep terminates early with -q, consequently locale -a will get a # SIGPIPE and the pipeline will fail with pipefail. shopt -o -u pipefail @@ -70,6 +76,9 @@ function setup_locale() { elif locale -a | grep -q en_US.UTF-8; then # Centos doesn't have C.UTF-8 export LANG=en_US.UTF-8 + elif locale -a | grep -q en_US.utf8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.utf8 else error "Failed to find usable locale" info "Available locales:" ===================================== aclocal.m4 ===================================== @@ -602,6 +602,18 @@ AC_DEFUN([FP_SETTINGS], else SettingsOptCommand="$OptCmd" fi + if test -z "$OtoolCmd" + then + SettingsOtoolCommand="otool" + else + SettingsOtoolCommand="$OtoolCmd" + fi + if test -z "$InstallNameToolCmd" + then + SettingsInstallNameToolCommand="install_name_tool" + else + SettingsInstallNameToolCommand="$InstallNameToolCmd" + fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -621,6 +633,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsMergeObjectsFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/GHC/Driver/Pipeline.hs ===================================== @@ -394,7 +394,56 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commands. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc's ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1188,8 +1237,11 @@ runPhase (HscOut src_flavour mod_name result) _ dflags = do hscGenHardCode hsc_env' cgguts mod_location output_fn final_iface <- liftIO (mkFullIface hsc_env'{hsc_dflags=iface_dflags} partial_iface (Just cg_infos)) - let final_mod_details = {-# SCC updateModDetailsIdInfos #-} - updateModDetailsIdInfos iface_dflags cg_infos mod_details + let final_mod_details + | gopt Opt_OmitInterfacePragmas iface_dflags + = mod_details + | otherwise = {-# SCC updateModDetailsIdInfos #-} + updateModDetailsIdInfos cg_infos mod_details setIface final_iface final_mod_details -- See Note [Writing interface files] @@ -1787,9 +1839,12 @@ linkBinary' staticLink dflags o_files dep_units = do rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then GHC.SysTools.runLibtool - else GHC.SysTools.runLink + let link dflags args | staticLink = GHC.SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = GHC.SysTools.runLink dflags args >> GHC.SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = GHC.SysTools.runLink dflags args + link dflags ( map GHC.SysTools.Option verbFlags ++ [ GHC.SysTools.Option "-o" @@ -1856,7 +1911,13 @@ linkBinary' staticLink dflags o_files dep_units = do ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/GHC/Driver/Session.hs ===================================== @@ -145,8 +145,8 @@ module GHC.Driver.Session ( versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, + pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool, + pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -885,6 +885,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags +pgm_otool :: DynFlags -> String +pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) @@ -2267,6 +2271,10 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } + , make_ord_flag defFlag "pgmotool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f} + , make_ord_flag defFlag "pgminstall_name_tool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f} , make_ord_flag defFlag "pgmranlib" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } @@ -3780,7 +3788,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -3791,6 +3798,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -3831,6 +3840,29 @@ default_PIC platform = -- information. _ -> [] + +-- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS +-- versions the number of load commands we can embed in a dynamic library is +-- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only +-- link the needed dylibs instead of linking the full dependency closure. +-- +-- If we split the library linking into injecting -rpath and -l @rpath/... +-- components, we will reduce the number of libraries we link, however we will +-- still inject one -rpath entry for each library, independent of their use. +-- That is, we even inject -rpath values for libraries that we dead_strip in +-- the end. As such we can run afoul of the load command size limit simply +-- by polluting the load commands with RPATH entries. +-- +-- Thus, we disable Opt_RPath by default on OSDarwin. The savvy user can always +-- enable it with -use-rpath if they so wish. +-- +-- See Note [Dynamic linking on macOS] + +default_RPath :: Platform -> [GeneralFlag] +default_RPath platform | platformOS platform == OSDarwin = [] +default_RPath _ = [Opt_RPath] + + -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] ===================================== compiler/GHC/Iface/UpdateIdInfos.hs ===================================== @@ -8,7 +8,6 @@ import GHC.Prelude import GHC.Core import GHC.Core.InstEnv -import GHC.Driver.Session import GHC.Driver.Types import GHC.StgToCmm.Types (CgInfos (..)) import GHC.Types.Id @@ -28,16 +27,11 @@ import GHC.Utils.Panic -- See Note [Conveying CAF-info and LFInfo between modules] in -- GHC.StgToCmm.Types. updateModDetailsIdInfos - :: DynFlags - -> CgInfos + :: CgInfos -> ModDetails -- ^ ModDetails to update -> ModDetails -updateModDetailsIdInfos dflags _ mod_details - | gopt Opt_OmitInterfacePragmas dflags - = mod_details - -updateModDetailsIdInfos _ cg_infos mod_details = +updateModDetailsIdInfos cg_infos mod_details = let ModDetails{ md_types = type_env -- for unfoldings , md_insts = insts ===================================== compiler/GHC/Runtime/Linker.hs ===================================== @@ -929,20 +929,22 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, ===================================== compiler/GHC/Settings.hs ===================================== @@ -34,6 +34,8 @@ module GHC.Settings , sPgm_windres , sPgm_libtool , sPgm_ar + , sPgm_otool + , sPgm_install_name_tool , sPgm_ranlib , sPgm_lo , sPgm_lc @@ -107,6 +109,8 @@ data ToolSettings = ToolSettings , toolSettings_pgm_windres :: String , toolSettings_pgm_libtool :: String , toolSettings_pgm_ar :: String + , toolSettings_pgm_otool :: String + , toolSettings_pgm_install_name_tool :: String , toolSettings_pgm_ranlib :: String , -- | LLVM: opt llvm optimiser toolSettings_pgm_lo :: (String, [Option]) @@ -216,6 +220,10 @@ sPgm_libtool :: Settings -> String sPgm_libtool = toolSettings_pgm_libtool . sToolSettings sPgm_ar :: Settings -> String sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_otool :: Settings -> String +sPgm_otool = toolSettings_pgm_otool . sToolSettings +sPgm_install_name_tool :: Settings -> String +sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings sPgm_ranlib :: Settings -> String sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings sPgm_lo :: Settings -> (String, [Option]) ===================================== compiler/GHC/Settings/IO.hs ===================================== @@ -115,6 +115,8 @@ initSettings top_dir = do windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -191,6 +193,8 @@ initSettings top_dir = do , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) ===================================== compiler/GHC/SysTools.hs ===================================== @@ -261,7 +261,10 @@ linkDynLib dflags0 o_files dep_packages | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `Set.member` ways dflags + -- Only if we want dynamic libraries + WayDyn `Set.member` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -386,8 +389,15 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the leftover + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO ===================================== compiler/GHC/SysTools/Tasks.hs ===================================== @@ -28,6 +28,10 @@ import GHC.CmmToLlvm.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pa import GHC.SysTools.Process import GHC.SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,41 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included in the load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of libraries end up being truely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath at . +-- +-- See Note [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + -- find any pre-existing LC_PATH items + info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib] + let paths = concatMap f info + where f ("path":p:_) = [p] + f _ = [] + lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ] + -- only find those rpaths, that aren't already in the library. + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths') + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -329,6 +368,17 @@ runAr dflags cwd args = traceToolCommand dflags "ar" $ do let ar = pgm_ar dflags runSomethingFiltered dflags id "Ar" ar args cwd Nothing +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing + runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do let ranlib = pgm_ranlib dflags ===================================== configure.ac ===================================== @@ -699,6 +699,18 @@ else fi AC_SUBST([LibtoolCmd]) +dnl ** Which otool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([OTOOL], [otool]) +OtoolCmd="$OTOOL" +AC_SUBST(OtoolCmd) + +dnl ** Which install_name_tool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool]) +InstallNameToolCmd="$INSTALL_NAME_TOOL" +AC_SUBST(InstallNameToolCmd) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -1522,6 +1534,8 @@ echo "\ libtool : $LibtoolCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd + otool : $OtoolCmd + install_name_tool : $InstallNameToolCmd windres : $WindresCmd dllwrap : $DllWrapCmd genlib : $GenlibCmd ===================================== docs/users_guide/phases.rst ===================================== @@ -95,6 +95,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only). +.. ghc-flag:: -pgmotool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inspect mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and + executables to read the dynamic library dependencies. We will compute + the necessary ``runpath``s to embed for the dependencies based on the + result of the ``otool`` call. + +.. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inject ``runpath`` into mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inject ``runpath``s into mach-o dynamic + libraries and executables. As detected by the ``otool`` call. + .. ghc-flag:: -pgmwindres ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the program for embedding manifests on Windows. :type: dynamic ===================================== hadrian/cfg/system.config.in ===================================== @@ -152,6 +152,8 @@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ +settings-otool-command = @SettingsOtoolCommand@ +settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-libtool-command = @SettingsLibtoolCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -114,6 +114,8 @@ data SettingsFileSetting | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_OtoolCommand + | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_LibtoolCommand @@ -200,6 +202,8 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_OtoolCommand -> "settings-otool-command" + SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -308,6 +308,8 @@ generateSettings = do , ("ar flags", expr $ lookupValueOrError configFile "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) ===================================== includes/ghc.mk ===================================== @@ -233,6 +233,8 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ + @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -504,6 +504,8 @@ SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ ===================================== testsuite/driver/perf_notes.py ===================================== @@ -22,7 +22,7 @@ import sys from collections import namedtuple from math import ceil, trunc -from testutil import passed, failBecause, testing_metrics +from testutil import passed, failBecause, testing_metrics, print_table from term_color import Color, colored from my_typing import * @@ -45,6 +45,14 @@ def inside_git_repo() -> bool: def is_worktree_dirty() -> bool: return subprocess.check_output(['git', 'status', '--porcelain']) != b'' +# Get length of abbreviated git commit hash +def get_abbrev_hash_length() -> int: + try: + return len(subprocess.check_output(['git', 'rev-parse', + '--short', 'HEAD']).strip()) + except subprocess.CalledProcessError: + return 10 + # # Some data access functions. At the moment this uses git notes. # @@ -100,6 +108,15 @@ class MetricChange(Enum): } return strings[self] + def short_name(self): + strings = { + MetricChange.NewMetric: "new", + MetricChange.NoChange: "unch", + MetricChange.Increase: "incr", + MetricChange.Decrease: "decr" + } + return strings[self] + AllowedPerfChange = NamedTuple('AllowedPerfChange', [('direction', MetricChange), ('metrics', List[str]), @@ -758,7 +775,7 @@ def main() -> None: exit(0) # - # String utilities for pretty-printing + # Print the data in tablular format # # T1234 T1234 @@ -770,11 +787,12 @@ def main() -> None: # HEAD~1 10023 10023 # HEAD~2 21234 21234 # HEAD~3 20000 20000 - - # Data is already in colum major format, so do that, calculate column widths - # then transpose and print each row. def strMetric(x): return '{:.2f}'.format(x.value) if x != None else "" + # Data is in colum major format, so transpose and pass to print_table. + T = TypeVar('T') + def transpose(xss: List[List[T]]) -> List[List[T]]: + return list(map(list, zip(*xss))) headerCols = [ ["","","","Commit"] ] \ + [ [name, metric, way, env] for (env, name, metric, way) in testSeries ] @@ -782,17 +800,7 @@ def main() -> None: + [ [strMetric(get_commit_metric(ref, commit, env, name, metric, way)) \ for commit in commits ] \ for (env, name, metric, way) in testSeries ] - colWidths = [max([2+len(cell) for cell in colH + colD]) for (colH,colD) in zip(headerCols, dataCols)] - col_fmts = ['{:>' + str(w) + '}' for w in colWidths] - - def printCols(cols): - for row in zip(*cols): - # print(list(zip(col_fmts, row))) - print(''.join([f.format(cell) for (f,cell) in zip(col_fmts, row)])) - - printCols(headerCols) - print('-'*(sum(colWidths)+2)) - printCols(dataCols) + print_table(transpose(headerCols), transpose(dataCols)) if __name__ == '__main__': main() ===================================== testsuite/driver/runtests.py ===================================== @@ -23,11 +23,11 @@ import traceback # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import getStdout, Watcher, str_warn, str_info +from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \ TestOptions, brokens, PerfMetric from my_typing import TestName -from perf_notes import MetricChange, GitRef, inside_git_repo, is_worktree_dirty, format_perf_stat +from perf_notes import MetricChange, GitRef, inside_git_repo, is_worktree_dirty, format_perf_stat, get_abbrev_hash_length, is_commit_hash from junit import junit import term_color from term_color import Color, colored @@ -341,23 +341,52 @@ def cleanup_and_exit(exitcode): exit(exitcode) def tabulate_metrics(metrics: List[PerfMetric]) -> None: - for metric in sorted(metrics, key=lambda m: (m.stat.test, m.stat.way, m.stat.metric)): - print("{test:24} {metric:40} {value:15.3f}".format( - test = "{}({})".format(metric.stat.test, metric.stat.way), - metric = metric.stat.metric, - value = metric.stat.value - )) - if metric.baseline is not None: - val0 = metric.baseline.perfStat.value - val1 = metric.stat.value - rel = 100 * (val1 - val0) / val0 - print("{space:24} {herald:40} {value:15.3f} [{direction}, {rel:2.1f}%]".format( - space = "", - herald = "(baseline @ {commit})".format( - commit = metric.baseline.commit), - value = val0, - direction = metric.change, - rel = rel + abbrevLen = get_abbrev_hash_length() + hasBaseline = any([x.baseline is not None for x in metrics]) + baselineCommitSet = set([x.baseline.commit for x in metrics if x.baseline is not None]) + hideBaselineCommit = not hasBaseline or len(baselineCommitSet) == 1 + hideBaselineEnv = not hasBaseline or all( + [x.stat.test_env == x.baseline.perfStat.test_env + for x in metrics if x.baseline is not None]) + def row(cells: Tuple[str, str, str, str, str, str, str]) -> List[str]: + return [x for (idx, x) in enumerate(list(cells)) if + (idx != 2 or not hideBaselineCommit) and + (idx != 3 or not hideBaselineEnv )] + + headerRows = [ + row(("", "", "Baseline", "Baseline", "Baseline", "", "")), + row(("Test", "Metric", "commit", "environment", "value", "New value", "Change")) + ] + def strDiff(x: PerfMetric) -> str: + if x.baseline is None: + return "" + val0 = x.baseline.perfStat.value + val1 = x.stat.value + return "{}({:+2.1f}%)".format(x.change.short_name(), 100 * (val1 - val0) / val0) + dataRows = [row(( + "{}({})".format(x.stat.test, x.stat.way), + shorten_metric_name(x.stat.metric), + "{}".format(x.baseline.commit[:abbrevLen] + if is_commit_hash(x.baseline.commit) else x.baseline.commit) + if x.baseline is not None else "", + "{}".format(x.baseline.perfStat.test_env) + if x.baseline is not None else "", + "{:13.1f}".format(x.baseline.perfStat.value) + if x.baseline is not None else "", + "{:13.1f}".format(x.stat.value), + strDiff(x) + )) for x in sorted(metrics, key = + lambda m: (m.stat.test, m.stat.way, m.stat.metric))] + print_table(headerRows, dataRows, 1) + print("") + if hasBaseline: + if hideBaselineEnv: + print("* All baselines were measured in the same environment as this test run") + if hideBaselineCommit: + commit = next(iter(baselineCommitSet)) + print("* All baseline commits are {}".format( + commit[:abbrevLen] + if is_commit_hash(commit) else commit )) # First collect all the tests to be run ===================================== testsuite/driver/testutil.py ===================================== @@ -144,3 +144,29 @@ def memoize(f): cached._cache = None return cached + +# Print the matrix data in a tabular format. +def print_table(header_rows: List[List[str]], data_rows: List[List[str]], padding=2) -> None: + # Calculate column widths then print each row. + colWidths = [(0 if idx == 0 else padding) + max([len(cell) for cell in col]) + for (idx, col) in enumerate(zip(*(header_rows + data_rows)))] + col_fmts = ['{:>' + str(w) + '}' for w in colWidths] + + def printCols(cols): + for row in cols: + print(''.join([f.format(cell) for (f,cell) in zip(col_fmts, row)])) + + printCols(header_rows) + print('-' * sum(colWidths)) + printCols(data_rows) + +def shorten_metric_name(name: str) -> str: + dic = { + "runtime/bytes allocated": "run/alloc", + "runtime/peak_megabytes_allocated": "run/peak", + "runtime/max_bytes_used": "run/max", + "compile_time/bytes allocated": "ghc/alloc", + "compile_time/peak_megabytes_allocated": "ghc/peak", + "compile_time/max_bytes_used": "ghc/max", + } + return dic.get(name, name) ===================================== testsuite/tests/rts/all.T ===================================== @@ -406,7 +406,7 @@ test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp - test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug']) test('T13676', - [when(opsys('darwin') or opsys('mingw32'), expect_broken(17447)), + [when(opsys('mingw32'), expect_broken(17447)), extra_files(['T13676.hs'])], ghci_script, ['T13676.script']) test('InitEventLogging', View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80f3f4a6922c2854af941853482998fe27b163db...86120f70895932b4a8996ac24e32b1cbd6564e8e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/80f3f4a6922c2854af941853482998fe27b163db...86120f70895932b4a8996ac24e32b1cbd6564e8e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 03:51:16 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Mon, 07 Sep 2020 23:51:16 -0400 Subject: [Git][ghc/ghc][wip/int64-everywhere] 54 commits: base: Better error message on invalid getSystemTimerManager call Message-ID: <5f56ffb41fa00_80b76ea74c109914cc@gitlab.haskell.org.mail> John Ericson pushed to branch wip/int64-everywhere at Glasgow Haskell Compiler / GHC Commits: 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - d0bebd40 by John Ericson at 2020-09-07T23:49:54-04:00 Use "to" instead of "2" in internal names of conversion ops Change the contructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversion from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 8e0263f9 by John Ericson at 2020-09-07T23:50:45-04:00 Make fixed-size `Int32#` and `Int64#` The boxed Int64 uses Int64#, but Int32# still uses Int#. The 32-bit case is less pressing to change because it is not a source of brittle CPP---it is the same thing on all platforms. We need Int64/Word64 constant folding to avoid the let/app restriction on Core, so that is implemented now. 32-bit constant unfolding and 32-bit literals are left as follow-up. This is the bulk of #11953 ghc-bignum: add support for Word64#/Int64# on 64-bit arch Fix fingerprint Core generation Fix some tests Co-authored-by: Sylvain Henry <hsyl20 at gmail.com> - - - - - fa3c9b9b by John Ericson at 2020-09-07T23:50:46-04:00 Inline INT64 and WORD64 macros in primops.txt.pp The definition is now unconditional so there is no reason for that CPP. - - - - - dc433872 by Sylvain Henry at 2020-09-07T23:50:46-04:00 Fix toArgRep - - - - - ae427ecb by Sylvain Henry at 2020-09-07T23:50:47-04:00 Adapt rules from #16402 to Word64#/Int64# - - - - - b2a579ec by John Ericson at 2020-09-07T23:50:47-04:00 Copy enumFrom* implementations from Int/Word for Int64/Word64 Without this, we don't get proper list fusion. I think this sort of copying is OK for now, but we absolutely need something better if we are going to make `IntN` use `IntN#` for all `N`. The degree to which proper metaprogramming has been punted upon by factoring everything through the native-sized types is disconcerting. - - - - - 38819576 by John Ericson at 2020-09-07T23:50:47-04:00 `integerFromInt64#` can be inlined when the word size is >= 64 bits Maybe this will help with the renaming test failure? - - - - - 3d10baf1 by John Ericson at 2020-09-07T23:50:47-04:00 Add builtin rule for `divInt64#` and `modInt64#` - - - - - 2c6bf270 by John Ericson at 2020-09-07T23:50:47-04:00 Add missing floats <-> int/word 64 rule and primops - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/CPrim.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Lint.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4ad1892180f714a36707de8a7702fd12cb8f248b...2c6bf2709c79fe8db96a3458aa00b2096a31f16e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4ad1892180f714a36707de8a7702fd12cb8f248b...2c6bf2709c79fe8db96a3458aa00b2096a31f16e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 03:51:35 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Mon, 07 Sep 2020 23:51:35 -0400 Subject: [Git][ghc/ghc][wip/int64-everywhere] WIP: Add missing floats <-> int/word 64 rule and primops Message-ID: <5f56ffc7b1bb2_80b3f845592568010991888@gitlab.haskell.org.mail> John Ericson pushed to branch wip/int64-everywhere at Glasgow Haskell Compiler / GHC Commits: 2c7f5d57 by John Ericson at 2020-09-07T23:51:16-04:00 WIP: Add missing floats <-> int/word 64 rule and primops - - - - - 15 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/CPrim.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Types/Literal.hs - includes/stg/Prim.h - libraries/base/GHC/Float.hs - libraries/base/GHC/Int.hs - libraries/ghc-prim/cbits/word2float.c Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -774,11 +774,15 @@ primop ChrOp "chr#" GenPrimOp Int# -> Char# primop IntToWordOp "int2Word#" GenPrimOp Int# -> Word# with code_size = 0 -primop IntToFloatOp "int2Float#" GenPrimOp Int# -> Float# -primop IntToDoubleOp "int2Double#" GenPrimOp Int# -> Double# +primop IntToFloatOp "int2Float#" GenPrimOp Int# -> Float# +primop IntToDoubleOp "int2Double#" GenPrimOp Int# -> Double# +primop Int64ToFloatOp "int64ToFloat#" GenPrimOp Int64# -> Float# +primop Int64ToDoubleOp "int64ToDouble#" GenPrimOp Int64# -> Double# -primop WordToFloatOp "word2Float#" GenPrimOp Word# -> Float# -primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double# +primop WordToFloatOp "word2Float#" GenPrimOp Word# -> Float# +primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double# +primop Word64ToFloatOp "word64ToFloat#" GenPrimOp Word64# -> Float# +primop Word64ToDoubleOp "word64ToDouble#" GenPrimOp Word64# -> Double# primop IntSllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int# {Shift left. Result undefined if shift amount is not @@ -1016,6 +1020,7 @@ primop DoubleToIntOp "double2Int#" GenPrimOp Double# -> Int# {Truncates a {\tt Double#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} +primop DoubleToInt64Op "doubleToInt64#" GenPrimOp Double# -> Int64# primop DoubleToFloatOp "double2Float#" GenPrimOp Double# -> Float# @@ -1170,6 +1175,7 @@ primop FloatToIntOp "float2Int#" GenPrimOp Float# -> Int# {Truncates a {\tt Float#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} +primop FloatToInt64Op "floatToInt64#" GenPrimOp Float# -> Int64# primop FloatExpOp "expFloat#" GenPrimOp Float# -> Float# ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -122,6 +122,7 @@ data MachOp -- is equivalent to just x. | MO_FF_Conv Width Width -- Float -> Float + -- Vector element insertion and extraction operations | MO_V_Insert Length Width -- Insert scalar into vector | MO_V_Extract Length Width -- Extract scalar from vector @@ -586,7 +587,7 @@ data CallishMachOp | MO_F32_Fabs | MO_F32_Sqrt - | MO_UF_Conv Width + | MO_UF_Conv Width Width -- unsigned int -> Float | MO_S_Mul2 Width | MO_S_QuotRem Width ===================================== compiler/GHC/CmmToAsm/CPrim.hs ===================================== @@ -84,8 +84,8 @@ ctzLabel w = "hs_ctz" ++ pprWidth w pprWidth W64 = "64" pprWidth w = pprPanic "ctzLabel: Unsupported word width " (ppr w) -word2FloatLabel :: Width -> String -word2FloatLabel w = "hs_word2float" ++ pprWidth w +word2FloatLabel :: Width -> Width -> String +word2FloatLabel wFrom wTo = "hs_word" ++ pprWidth wFrom ++ "_to_float" ++ pprWidth wTo where pprWidth W32 = "32" pprWidth W64 = "64" ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -2009,7 +2009,7 @@ genCCall' config gcp target dest_regs args MO_F64_Acosh -> (fsLit "acosh", False) MO_F64_Atanh -> (fsLit "atanh", False) - MO_UF_Conv w -> (fsLit $ word2FloatLabel w, False) + MO_UF_Conv wFrom wTo -> (fsLit $ word2FloatLabel wFrom wTo, False) MO_Memcpy _ -> (fsLit "memcpy", False) MO_Memset _ -> (fsLit "memset", False) ===================================== compiler/GHC/CmmToAsm/SPARC/CodeGen.hs ===================================== @@ -661,7 +661,7 @@ outOfLineMachOp_table mop MO_F64_Acosh -> fsLit "acosh" MO_F64_Atanh -> fsLit "atanh" - MO_UF_Conv w -> fsLit $ word2FloatLabel w + MO_UF_Conv wFrom wTo -> fsLit $ word2FloatLabel wFrom wTo MO_Memcpy _ -> fsLit "memcpy" MO_Memset _ -> fsLit "memset" ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2507,7 +2507,7 @@ genCCall' config is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bw = widthInBits width lbl = mkCmmCodeLabel primUnitId (fsLit (clzLabel width)) -genCCall' config is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do +genCCall' config is32Bit (PrimTarget (MO_UF_Conv wFrom wTo)) dest_regs args bid = do targetExpr <- cmmMakeDynamicReference config CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv @@ -2515,7 +2515,7 @@ genCCall' config is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do CmmMayReturn) genCCall' config is32Bit target dest_regs args bid where - lbl = mkCmmCodeLabel primUnitId (fsLit (word2FloatLabel width)) + lbl = mkCmmCodeLabel primUnitId $ fsLit $ word2FloatLabel wFrom wTo genCCall' _ _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] _ = do load_code <- intLoadCode (MOV (intFormat width)) addr @@ -3341,7 +3341,7 @@ outOfLineCmmOp bid mop res args MO_Cmpxchg _ -> fsLit "cmpxchg" MO_Xchg _ -> should_be_inline - MO_UF_Conv _ -> unsupported + MO_UF_Conv _ _ -> unsupported MO_S_Mul2 {} -> unsupported MO_S_QuotRem {} -> unsupported ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -821,7 +821,7 @@ pprCallishMachOp_for_C mop (MO_Xchg w) -> ptext (sLit $ xchgLabel w) (MO_AtomicRead w) -> ptext (sLit $ atomicReadLabel w) (MO_AtomicWrite w) -> ptext (sLit $ atomicWriteLabel w) - (MO_UF_Conv w) -> ptext (sLit $ word2FloatLabel w) + (MO_UF_Conv wFrom wTo) -> ptext (sLit $ word2FloatLabel wFrom wTo) MO_S_Mul2 {} -> unsupported MO_S_QuotRem {} -> unsupported ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -201,7 +201,7 @@ genCall (PrimTarget MO_WriteBarrier) _ _ = do genCall (PrimTarget MO_Touch) _ _ = return (nilOL, []) -genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do +genCall (PrimTarget (MO_UF_Conv _ w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst width = widthToLlvmFloat w @@ -210,7 +210,7 @@ genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do statement $ Assignment castV $ Cast LM_Uitofp ve width statement $ Store castV dstV -genCall (PrimTarget (MO_UF_Conv _)) [_] args = +genCall (PrimTarget (MO_UF_Conv _ _)) [_] args = panic $ "genCall: Too many arguments to MO_UF_Conv. " ++ "Can only handle 1, given" ++ show (length args) ++ "." @@ -897,7 +897,7 @@ cmmPrimOpFunctions mop = do MO_ReadBarrier -> unsupported MO_WriteBarrier -> unsupported MO_Touch -> unsupported - MO_UF_Conv _ -> unsupported + MO_UF_Conv _ _ -> unsupported MO_AtomicRead _ -> unsupported MO_AtomicRMW _ _ -> unsupported ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -315,6 +315,10 @@ primOpRules nm = \case IntToFloatOp -> mkPrimOpRule nm 1 [ liftLit intToFloatLit ] DoubleToIntOp -> mkPrimOpRule nm 1 [ liftLit doubleToIntLit ] IntToDoubleOp -> mkPrimOpRule nm 1 [ liftLit intToDoubleLit ] + FloatToInt64Op -> mkPrimOpRule nm 1 [ liftLit floatToInt64Lit ] + Int64ToFloatOp -> mkPrimOpRule nm 1 [ liftLit int64ToFloatLit ] + DoubleToInt64Op -> mkPrimOpRule nm 1 [ liftLit doubleToInt64Lit ] + Int64ToDoubleOp -> mkPrimOpRule nm 1 [ liftLit int64ToDoubleLit ] -- SUP: Not sure what the standard says about precision in the following 2 cases FloatToDoubleOp -> mkPrimOpRule nm 1 [ liftLit floatToDoubleLit ] DoubleToFloatOp -> mkPrimOpRule nm 1 [ liftLit doubleToFloatLit ] ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -841,9 +841,14 @@ emitPrimOp dflags primop = case primop of -- Unsigned int to floating point conversions WordToFloatOp -> \[w] -> opIntoRegs $ \[res] -> do - emitPrimCall [res] (MO_UF_Conv W32) [w] + emitPrimCall [res] (MO_UF_Conv (wordWidth platform) W32) [w] + Word64ToFloatOp -> \[w] -> opIntoRegs $ \[res] -> do + emitPrimCall [res] (MO_UF_Conv W64 W32) [w] + WordToDoubleOp -> \[w] -> opIntoRegs $ \[res] -> do - emitPrimCall [res] (MO_UF_Conv W64) [w] + emitPrimCall [res] (MO_UF_Conv (wordWidth platform) W64) [w] + Word64ToDoubleOp -> \[w] -> opIntoRegs $ \[res] -> do + emitPrimCall [res] (MO_UF_Conv W64 W64) [w] -- Atomic operations InterlockedExchange_Addr -> \[src, value] -> opIntoRegs $ \[res] -> @@ -1408,9 +1413,15 @@ emitPrimOp dflags primop = case primop of IntToDoubleOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W64) DoubleToIntOp -> \args -> opTranslate args (MO_FS_Conv W64 (wordWidth platform)) + Int64ToDoubleOp -> \args -> opTranslate args (MO_SF_Conv W64 W64) + DoubleToInt64Op -> \args -> opTranslate args (MO_FS_Conv W64 W64) + IntToFloatOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W32) FloatToIntOp -> \args -> opTranslate args (MO_FS_Conv W32 (wordWidth platform)) + Int64ToFloatOp -> \args -> opTranslate args (MO_SF_Conv W64 W32) + FloatToInt64Op -> \args -> opTranslate args (MO_FS_Conv W32 W64) + FloatToDoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64) DoubleToFloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32) ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -45,8 +45,12 @@ module GHC.Types.Literal , narrow8IntLit, narrow16IntLit, narrow32IntLit , narrow8WordLit, narrow16WordLit, narrow32WordLit , charToIntLit, intToCharLit - , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit - , nullAddrLit, rubbishLit, floatToDoubleLit, doubleToFloatLit + , floatToIntLit, intToFloatLit + , floatToInt64Lit, int64ToFloatLit + , doubleToIntLit, intToDoubleLit + , doubleToInt64Lit, int64ToDoubleLit + , floatToDoubleLit, doubleToFloatLit + , nullAddrLit, rubbishLit ) where #include "HsVersions.h" @@ -487,7 +491,10 @@ isLitValue = isJust . isLitValue_maybe narrow8IntLit, narrow16IntLit, narrow32IntLit, narrow8WordLit, narrow16WordLit, narrow32WordLit, charToIntLit, intToCharLit, - floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit, + floatToIntLit, intToFloatLit, + floatToInt64Lit, int64ToFloatLit, + doubleToIntLit, intToDoubleLit, + doubleToInt64Lit, int64ToDoubleLit, floatToDoubleLit, doubleToFloatLit :: Literal -> Literal @@ -553,11 +560,21 @@ floatToIntLit l = pprPanic "floatToIntLit" (ppr l) intToFloatLit (LitNumber _ i) = LitFloat (fromInteger i) intToFloatLit l = pprPanic "intToFloatLit" (ppr l) +floatToInt64Lit (LitFloat f) = mkLitInt64Unchecked (truncate f) +floatToInt64Lit l = pprPanic "floatToInt64Lit" (ppr l) +int64ToFloatLit (LitNumber _ i) = LitFloat (fromInteger i) +int64ToFloatLit l = pprPanic "int64ToFloatLit" (ppr l) + doubleToIntLit (LitDouble f) = mkLitIntUnchecked (truncate f) doubleToIntLit l = pprPanic "doubleToIntLit" (ppr l) intToDoubleLit (LitNumber _ i) = LitDouble (fromInteger i) intToDoubleLit l = pprPanic "intToDoubleLit" (ppr l) +doubleToInt64Lit (LitDouble f) = mkLitInt64Unchecked (truncate f) +doubleToInt64Lit l = pprPanic "doubleToInt64Lit" (ppr l) +int64ToDoubleLit (LitNumber _ i) = LitDouble (fromInteger i) +int64ToDoubleLit l = pprPanic "int64ToDoubleLit" (ppr l) + floatToDoubleLit (LitFloat f) = LitDouble f floatToDoubleLit l = pprPanic "floatToDoubleLit" (ppr l) doubleToFloatLit (LitDouble d) = LitFloat d ===================================== includes/stg/Prim.h ===================================== @@ -88,8 +88,10 @@ StgWord hs_popcnt64(StgWord64 x); StgWord hs_popcnt(StgWord x); /* libraries/ghc-prim/cbits/word2float.c */ -StgFloat hs_word2float32(StgWord x); -StgDouble hs_word2float64(StgWord x); +StgFloat hs_word32_to_float32(StgWord32 x); +StgDouble hs_word32_to_float64(StgWord32 x); +StgFloat hs_word64_to_float32(StgWord64 x); +StgDouble hs_word64_to_float64(StgWord64 x); /* libraries/ghc-prim/cbits/clz.c */ StgWord hs_clz8(StgWord x); ===================================== libraries/base/GHC/Float.hs ===================================== @@ -1296,8 +1296,11 @@ word2Float (W# w) = F# (word2Float# w) "realToFrac/Float->Double" realToFrac = float2Double "realToFrac/Double->Float" realToFrac = double2Float "realToFrac/Double->Double" realToFrac = id :: Double -> Double -"realToFrac/Int->Double" realToFrac = int2Double -- See Note [realToFrac int-to-float] -"realToFrac/Int->Float" realToFrac = int2Float -- ..ditto +-- See Note [realToFrac int-to-float] on the below +"realToFrac/Int->Double" realToFrac = int2Double +"realToFrac/Int->Float" realToFrac = int2Float +"realToFrac/Word->Double" realToFrac = Word2Double +"realToFrac/Word->Float" realToFrac = Word2Float #-} {- ===================================== libraries/base/GHC/Int.hs ===================================== @@ -33,7 +33,10 @@ module GHC.Int ( eqInt8, neInt8, gtInt8, geInt8, ltInt8, leInt8, eqInt16, neInt16, gtInt16, geInt16, ltInt16, leInt16, eqInt32, neInt32, gtInt32, geInt32, ltInt32, leInt32, - eqInt64, neInt64, gtInt64, geInt64, ltInt64, leInt64 + eqInt64, neInt64, gtInt64, geInt64, ltInt64, leInt64, + -- * Floating point converions + doubleToInt64, int64ToDouble, + floatToInt6m, int64ToFloat ) where import Data.Bits @@ -223,6 +226,15 @@ instance FiniteBits Int8 where "fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8 "fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (narrow8Int# x#) "fromIntegral/Int8->a" fromIntegral = \(I8# x#) -> fromIntegral (I# x#) +-- See Note [realToFrac int-to-float] about below +"fromIntegral/Int64->Float" fromIntegral = int64ToFloat +"fromIntegral/Int64->Double" fromIntegral = int64ToDouble +"fromIntegral/Word64->Float" fromIntegral = word64ToFloat +"fromIntegral/Word64->Double" fromIntegral = word64ToDouble +"realToFrac/Int64->Double" realToFrac = int64ToDouble +"realToFrac/Int64->Float" realToFrac = int64ToFloat +"realToFrac/Word64->Double" realToFrac = int64ToDouble +"realToFrac/Word64->Float" realToFrac = int64ToFloat #-} {-# RULES @@ -992,6 +1004,18 @@ a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# else intToInt64# 0# | otherwise = a `uncheckedIShiftRA64#` b +doubleToInt64 :: Double -> Int64 +doubleToInt64 (D# x) = I64# (doubleToInt64# x) + +int64ToDouble :: Int64 -> Double +int64ToDouble (I64# i) = D# (int64ToDouble# i) + +floatToInt64 :: Float -> Int64 +floatToInt64 (F# x) = I64# (floatToInt64# x) + +int64ToFloat :: Int64 -> Float +int64ToFloat (I64# i) = F# (int64ToFloat# i) + {-# RULES "fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#) "fromIntegral/Word->Int64" fromIntegral = \(W# x#) -> I64# (word64ToInt64# (wordToWord64# x#)) ===================================== libraries/ghc-prim/cbits/word2float.c ===================================== @@ -1,15 +1,29 @@ #include "Rts.h" -extern StgFloat hs_word2float32(StgWord x); +extern StgFloat hs_word32_to_float32(StgWord32 x); StgFloat -hs_word2float32(StgWord x) +hs_word32_to_float32(StgWord32 x) { return x; } -extern StgDouble hs_word2float64(StgWord x); +extern StgDouble hs_word32_to_float64(StgWord32 x); StgDouble -hs_word2float64(StgWord x) +hs_word32_to_float64(StgWord32 x) +{ + return x; +} + +extern StgFloat hs_word64_to_float32(StgWord64 x); +StgFloat +hs_word64_to_float32(StgWord64 x) +{ + return x; +} + +extern StgDouble hs_word64_to_float64(StgWord64 x); +StgDouble +hs_word64_to_float64(StgWord64 x) { return x; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c7f5d578e9eba7738173f1534a3f81c3faeab65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2c7f5d578e9eba7738173f1534a3f81c3faeab65 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 03:55:13 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Mon, 07 Sep 2020 23:55:13 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/conversion-no-two Message-ID: <5f5700a15036e_80b3f848695aef8109935d0@gitlab.haskell.org.mail> John Ericson pushed new branch wip/conversion-no-two at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/conversion-no-two You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 03:56:22 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Mon, 07 Sep 2020 23:56:22 -0400 Subject: [Git][ghc/ghc][wip/conversion-no-two] Use "to" instead of "2" in internal names of conversion ops Message-ID: <5f5700e6114d_80b3f842955f0b81099377c@gitlab.haskell.org.mail> John Ericson pushed to branch wip/conversion-no-two at Glasgow Haskell Compiler / GHC Commits: 91cc1d00 by John Ericson at 2020-09-07T23:56:01-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversion from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 4 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Types/Literal.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -603,14 +603,14 @@ primop IntLeOp "<=#" Compare Int# -> Int# -> Int# primop ChrOp "chr#" GenPrimOp Int# -> Char# with code_size = 0 -primop Int2WordOp "int2Word#" GenPrimOp Int# -> Word# +primop IntToWordOp "int2Word#" GenPrimOp Int# -> Word# with code_size = 0 -primop Int2FloatOp "int2Float#" GenPrimOp Int# -> Float# -primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double# +primop IntToFloatOp "int2Float#" GenPrimOp Int# -> Float# +primop IntToDoubleOp "int2Double#" GenPrimOp Int# -> Double# -primop Word2FloatOp "word2Float#" GenPrimOp Word# -> Float# -primop Word2DoubleOp "word2Double#" GenPrimOp Word# -> Double# +primop WordToFloatOp "word2Float#" GenPrimOp Word# -> Float# +primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double# primop ISllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int# {Shift left. Result undefined if shift amount is not @@ -696,7 +696,7 @@ primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word# {Shift right logical. Result undefined if shift amount is not in the range 0 to word size - 1 inclusive.} -primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int# +primop WordToIntOp "word2Int#" GenPrimOp Word# -> Int# with code_size = 0 primop WordGtOp "gtWord#" Compare Word# -> Word# -> Int# @@ -844,12 +844,12 @@ primop DoubleNegOp "negateDouble#" GenPrimOp Double# -> Double# primop DoubleFabsOp "fabsDouble#" GenPrimOp Double# -> Double# -primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int# +primop DoubleToIntOp "double2Int#" GenPrimOp Double# -> Int# {Truncates a {\tt Double#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} -primop Double2FloatOp "double2Float#" GenPrimOp Double# -> Float# +primop DoubleToFloatOp "double2Float#" GenPrimOp Double# -> Float# primop DoubleExpOp "expDouble#" GenPrimOp Double# -> Double# @@ -998,7 +998,7 @@ primop FloatNegOp "negateFloat#" GenPrimOp Float# -> Float# primop FloatFabsOp "fabsFloat#" GenPrimOp Float# -> Float# -primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int# +primop FloatToIntOp "float2Int#" GenPrimOp Float# -> Int# {Truncates a {\tt Float#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} @@ -1097,7 +1097,7 @@ primop FloatPowerOp "powerFloat#" GenPrimOp with code_size = { primOpCodeSizeForeignCall } -primop Float2DoubleOp "float2Double#" GenPrimOp Float# -> Double# +primop FloatToDoubleOp "float2Double#" GenPrimOp Float# -> Double# primop FloatDecode_IntOp "decodeFloat_Int#" GenPrimOp Float# -> (# Int#, Int# #) @@ -2283,11 +2283,11 @@ primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int# primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int# {Return the remainder when the {\tt Addr\#} arg, treated like an {\tt Int\#}, is divided by the {\tt Int\#} arg.} -primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int# +primop AddrToIntOp "addr2Int#" GenPrimOp Addr# -> Int# {Coerce directly from address to int.} with code_size = 0 deprecated_msg = { This operation is strongly deprecated. } -primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr# +primop IntToAddrOp "int2Addr#" GenPrimOp Int# -> Addr# {Coerce directly from int to address.} with code_size = 0 deprecated_msg = { This operation is strongly deprecated. } ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -193,10 +193,10 @@ primOpRules nm = \case SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogical ] -- coercions - Word2IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform word2IntLit - , inversePrimOp Int2WordOp ] - Int2WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform int2WordLit - , inversePrimOp Word2IntOp ] + WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform wordToIntLit + , inversePrimOp IntToWordOp ] + IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform intToWordLit + , inversePrimOp WordToIntOp ] Narrow8IntOp -> mkPrimOpRule nm 1 [ liftLit narrow8IntLit , subsumedByPrimOp Narrow8IntOp , Narrow8IntOp `subsumesPrimOp` Narrow16IntOp @@ -229,19 +229,19 @@ primOpRules nm = \case , subsumedByPrimOp Narrow32WordOp , removeOp32 , narrowSubsumesAnd AndOp Narrow32WordOp 32 ] - OrdOp -> mkPrimOpRule nm 1 [ liftLit char2IntLit + OrdOp -> mkPrimOpRule nm 1 [ liftLit charToIntLit , inversePrimOp ChrOp ] ChrOp -> mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs guard (litFitsInChar lit) - liftLit int2CharLit + liftLit intToCharLit , inversePrimOp OrdOp ] - Float2IntOp -> mkPrimOpRule nm 1 [ liftLit float2IntLit ] - Int2FloatOp -> mkPrimOpRule nm 1 [ liftLit int2FloatLit ] - Double2IntOp -> mkPrimOpRule nm 1 [ liftLit double2IntLit ] - Int2DoubleOp -> mkPrimOpRule nm 1 [ liftLit int2DoubleLit ] + FloatToIntOp -> mkPrimOpRule nm 1 [ liftLit floatToIntLit ] + IntToFloatOp -> mkPrimOpRule nm 1 [ liftLit intToFloatLit ] + DoubleToIntOp -> mkPrimOpRule nm 1 [ liftLit doubleToIntLit ] + IntToDoubleOp -> mkPrimOpRule nm 1 [ liftLit intToDoubleLit ] -- SUP: Not sure what the standard says about precision in the following 2 cases - Float2DoubleOp -> mkPrimOpRule nm 1 [ liftLit float2DoubleLit ] - Double2FloatOp -> mkPrimOpRule nm 1 [ liftLit double2FloatLit ] + FloatToDoubleOp -> mkPrimOpRule nm 1 [ liftLit floatToDoubleLit ] + DoubleToFloatOp -> mkPrimOpRule nm 1 [ liftLit doubleToFloatLit ] -- Float FloatAddOp -> mkPrimOpRule nm 2 [ binaryLit (floatOp2 (+)) @@ -1364,9 +1364,9 @@ builtinBignumRules _ = , rule_passthrough "Word# -> Integer -> Word#" integerToWordName integerFromWordName , rule_passthrough "Int64# -> Integer -> Int64#" integerToInt64Name integerFromInt64Name , rule_passthrough "Word64# -> Integer -> Word64#" integerToWord64Name integerFromWord64Name - , rule_smallIntegerTo "IS -> Word#" integerToWordName Int2WordOp - , rule_smallIntegerTo "IS -> Float" integerToFloatName Int2FloatOp - , rule_smallIntegerTo "IS -> Double" integerToDoubleName Int2DoubleOp + , rule_smallIntegerTo "IS -> Word#" integerToWordName IntToWordOp + , rule_smallIntegerTo "IS -> Float" integerToFloatName IntToFloatOp + , rule_smallIntegerTo "IS -> Double" integerToDoubleName IntToDoubleOp , rule_passthrough "Word# -> Natural -> Word#" naturalToWordName naturalNSDataConName , rule_IntegerToNaturalClamp "Integer -> Natural (clamp)" integerToNaturalClampName ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -840,9 +840,9 @@ emitPrimOp dflags primop = case primop of emitCtzCall res w (wordWidth platform) -- Unsigned int to floating point conversions - Word2FloatOp -> \[w] -> opIntoRegs $ \[res] -> do + WordToFloatOp -> \[w] -> opIntoRegs $ \[res] -> do emitPrimCall [res] (MO_UF_Conv W32) [w] - Word2DoubleOp -> \[w] -> opIntoRegs $ \[res] -> do + WordToDoubleOp -> \[w] -> opIntoRegs $ \[res] -> do emitPrimCall [res] (MO_UF_Conv W64) [w] -- Atomic operations @@ -1056,10 +1056,10 @@ emitPrimOp dflags primop = case primop of -- The rest just translate straightforwardly - Int2WordOp -> \args -> opNop args - Word2IntOp -> \args -> opNop args - Int2AddrOp -> \args -> opNop args - Addr2IntOp -> \args -> opNop args + IntToWordOp -> \args -> opNop args + WordToIntOp -> \args -> opNop args + IntToAddrOp -> \args -> opNop args + AddrToIntOp -> \args -> opNop args ChrOp -> \args -> opNop args -- Int# and Char# are rep'd the same OrdOp -> \args -> opNop args @@ -1309,14 +1309,14 @@ emitPrimOp dflags primop = case primop of -- Conversions - Int2DoubleOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W64) - Double2IntOp -> \args -> opTranslate args (MO_FS_Conv W64 (wordWidth platform)) + IntToDoubleOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W64) + DoubleToIntOp -> \args -> opTranslate args (MO_FS_Conv W64 (wordWidth platform)) - Int2FloatOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W32) - Float2IntOp -> \args -> opTranslate args (MO_FS_Conv W32 (wordWidth platform)) + IntToFloatOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W32) + FloatToIntOp -> \args -> opTranslate args (MO_FS_Conv W32 (wordWidth platform)) - Float2DoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64) - Double2FloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32) + FloatToDoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64) + DoubleToFloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32) -- Word comparisons masquerading as more exotic things. ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -39,13 +39,13 @@ module GHC.Types.Literal , litValue, isLitValue, isLitValue_maybe, mapLitValue -- ** Coercions - , word2IntLit, int2WordLit + , wordToIntLit, intToWordLit , narrowLit , narrow8IntLit, narrow16IntLit, narrow32IntLit , narrow8WordLit, narrow16WordLit, narrow32WordLit - , char2IntLit, int2CharLit - , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit - , nullAddrLit, rubbishLit, float2DoubleLit, double2FloatLit + , charToIntLit, intToCharLit + , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit + , nullAddrLit, rubbishLit, floatToDoubleLit, doubleToFloatLit ) where #include "HsVersions.h" @@ -474,27 +474,27 @@ isLitValue = isJust . isLitValue_maybe narrow8IntLit, narrow16IntLit, narrow32IntLit, narrow8WordLit, narrow16WordLit, narrow32WordLit, - char2IntLit, int2CharLit, - float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit, - float2DoubleLit, double2FloatLit + charToIntLit, intToCharLit, + floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit, + floatToDoubleLit, doubleToFloatLit :: Literal -> Literal -word2IntLit, int2WordLit :: Platform -> Literal -> Literal -word2IntLit platform (LitNumber LitNumWord w) +wordToIntLit, intToWordLit :: Platform -> Literal -> Literal +wordToIntLit platform (LitNumber LitNumWord w) -- Map Word range [max_int+1, max_word] -- to Int range [min_int , -1] -- Range [0,max_int] has the same representation with both Int and Word | w > platformMaxInt platform = mkLitInt platform (w - platformMaxWord platform - 1) | otherwise = mkLitInt platform w -word2IntLit _ l = pprPanic "word2IntLit" (ppr l) +wordToIntLit _ l = pprPanic "wordToIntLit" (ppr l) -int2WordLit platform (LitNumber LitNumInt i) +intToWordLit platform (LitNumber LitNumInt i) -- Map Int range [min_int , -1] -- to Word range [max_int+1, max_word] -- Range [0,max_int] has the same representation with both Int and Word | i < 0 = mkLitWord platform (1 + platformMaxWord platform + i) | otherwise = mkLitWord platform i -int2WordLit _ l = pprPanic "int2WordLit" (ppr l) +intToWordLit _ l = pprPanic "intToWordLit" (ppr l) -- | Narrow a literal number (unchecked result range) narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal @@ -508,25 +508,25 @@ narrow8WordLit = narrowLit (Proxy :: Proxy Word8) narrow16WordLit = narrowLit (Proxy :: Proxy Word16) narrow32WordLit = narrowLit (Proxy :: Proxy Word32) -char2IntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c)) -char2IntLit l = pprPanic "char2IntLit" (ppr l) -int2CharLit (LitNumber _ i) = LitChar (chr (fromInteger i)) -int2CharLit l = pprPanic "int2CharLit" (ppr l) - -float2IntLit (LitFloat f) = mkLitIntUnchecked (truncate f) -float2IntLit l = pprPanic "float2IntLit" (ppr l) -int2FloatLit (LitNumber _ i) = LitFloat (fromInteger i) -int2FloatLit l = pprPanic "int2FloatLit" (ppr l) - -double2IntLit (LitDouble f) = mkLitIntUnchecked (truncate f) -double2IntLit l = pprPanic "double2IntLit" (ppr l) -int2DoubleLit (LitNumber _ i) = LitDouble (fromInteger i) -int2DoubleLit l = pprPanic "int2DoubleLit" (ppr l) - -float2DoubleLit (LitFloat f) = LitDouble f -float2DoubleLit l = pprPanic "float2DoubleLit" (ppr l) -double2FloatLit (LitDouble d) = LitFloat d -double2FloatLit l = pprPanic "double2FloatLit" (ppr l) +charToIntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c)) +charToIntLit l = pprPanic "charToIntLit" (ppr l) +intToCharLit (LitNumber _ i) = LitChar (chr (fromInteger i)) +intToCharLit l = pprPanic "intToCharLit" (ppr l) + +floatToIntLit (LitFloat f) = mkLitIntUnchecked (truncate f) +floatToIntLit l = pprPanic "floatToIntLit" (ppr l) +intToFloatLit (LitNumber _ i) = LitFloat (fromInteger i) +intToFloatLit l = pprPanic "intToFloatLit" (ppr l) + +doubleToIntLit (LitDouble f) = mkLitIntUnchecked (truncate f) +doubleToIntLit l = pprPanic "doubleToIntLit" (ppr l) +intToDoubleLit (LitNumber _ i) = LitDouble (fromInteger i) +intToDoubleLit l = pprPanic "intToDoubleLit" (ppr l) + +floatToDoubleLit (LitFloat f) = LitDouble f +floatToDoubleLit l = pprPanic "floatToDoubleLit" (ppr l) +doubleToFloatLit (LitDouble d) = LitFloat d +doubleToFloatLit l = pprPanic "doubleToFloatLit" (ppr l) nullAddrLit :: Literal nullAddrLit = LitNullAddr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91cc1d00ec2b5153c0f70cd4144891dfc6b62eef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/91cc1d00ec2b5153c0f70cd4144891dfc6b62eef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 03:58:36 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Mon, 07 Sep 2020 23:58:36 -0400 Subject: [Git][ghc/ghc][wip/conversion-no-two] Use "to" instead of "2" in internal names of conversion ops Message-ID: <5f57016cca873_80b3f848659d48c109953db@gitlab.haskell.org.mail> John Ericson pushed to branch wip/conversion-no-two at Glasgow Haskell Compiler / GHC Commits: c1b8b1e2 by John Ericson at 2020-09-07T23:58:03-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 4 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Types/Literal.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -603,14 +603,14 @@ primop IntLeOp "<=#" Compare Int# -> Int# -> Int# primop ChrOp "chr#" GenPrimOp Int# -> Char# with code_size = 0 -primop Int2WordOp "int2Word#" GenPrimOp Int# -> Word# +primop IntToWordOp "int2Word#" GenPrimOp Int# -> Word# with code_size = 0 -primop Int2FloatOp "int2Float#" GenPrimOp Int# -> Float# -primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double# +primop IntToFloatOp "int2Float#" GenPrimOp Int# -> Float# +primop IntToDoubleOp "int2Double#" GenPrimOp Int# -> Double# -primop Word2FloatOp "word2Float#" GenPrimOp Word# -> Float# -primop Word2DoubleOp "word2Double#" GenPrimOp Word# -> Double# +primop WordToFloatOp "word2Float#" GenPrimOp Word# -> Float# +primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double# primop ISllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int# {Shift left. Result undefined if shift amount is not @@ -696,7 +696,7 @@ primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word# {Shift right logical. Result undefined if shift amount is not in the range 0 to word size - 1 inclusive.} -primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int# +primop WordToIntOp "word2Int#" GenPrimOp Word# -> Int# with code_size = 0 primop WordGtOp "gtWord#" Compare Word# -> Word# -> Int# @@ -844,12 +844,12 @@ primop DoubleNegOp "negateDouble#" GenPrimOp Double# -> Double# primop DoubleFabsOp "fabsDouble#" GenPrimOp Double# -> Double# -primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int# +primop DoubleToIntOp "double2Int#" GenPrimOp Double# -> Int# {Truncates a {\tt Double#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} -primop Double2FloatOp "double2Float#" GenPrimOp Double# -> Float# +primop DoubleToFloatOp "double2Float#" GenPrimOp Double# -> Float# primop DoubleExpOp "expDouble#" GenPrimOp Double# -> Double# @@ -998,7 +998,7 @@ primop FloatNegOp "negateFloat#" GenPrimOp Float# -> Float# primop FloatFabsOp "fabsFloat#" GenPrimOp Float# -> Float# -primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int# +primop FloatToIntOp "float2Int#" GenPrimOp Float# -> Int# {Truncates a {\tt Float#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} @@ -1097,7 +1097,7 @@ primop FloatPowerOp "powerFloat#" GenPrimOp with code_size = { primOpCodeSizeForeignCall } -primop Float2DoubleOp "float2Double#" GenPrimOp Float# -> Double# +primop FloatToDoubleOp "float2Double#" GenPrimOp Float# -> Double# primop FloatDecode_IntOp "decodeFloat_Int#" GenPrimOp Float# -> (# Int#, Int# #) @@ -2283,11 +2283,11 @@ primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int# primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int# {Return the remainder when the {\tt Addr\#} arg, treated like an {\tt Int\#}, is divided by the {\tt Int\#} arg.} -primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int# +primop AddrToIntOp "addr2Int#" GenPrimOp Addr# -> Int# {Coerce directly from address to int.} with code_size = 0 deprecated_msg = { This operation is strongly deprecated. } -primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr# +primop IntToAddrOp "int2Addr#" GenPrimOp Int# -> Addr# {Coerce directly from int to address.} with code_size = 0 deprecated_msg = { This operation is strongly deprecated. } ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -193,10 +193,10 @@ primOpRules nm = \case SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogical ] -- coercions - Word2IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform word2IntLit - , inversePrimOp Int2WordOp ] - Int2WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform int2WordLit - , inversePrimOp Word2IntOp ] + WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform wordToIntLit + , inversePrimOp IntToWordOp ] + IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform intToWordLit + , inversePrimOp WordToIntOp ] Narrow8IntOp -> mkPrimOpRule nm 1 [ liftLit narrow8IntLit , subsumedByPrimOp Narrow8IntOp , Narrow8IntOp `subsumesPrimOp` Narrow16IntOp @@ -229,19 +229,19 @@ primOpRules nm = \case , subsumedByPrimOp Narrow32WordOp , removeOp32 , narrowSubsumesAnd AndOp Narrow32WordOp 32 ] - OrdOp -> mkPrimOpRule nm 1 [ liftLit char2IntLit + OrdOp -> mkPrimOpRule nm 1 [ liftLit charToIntLit , inversePrimOp ChrOp ] ChrOp -> mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs guard (litFitsInChar lit) - liftLit int2CharLit + liftLit intToCharLit , inversePrimOp OrdOp ] - Float2IntOp -> mkPrimOpRule nm 1 [ liftLit float2IntLit ] - Int2FloatOp -> mkPrimOpRule nm 1 [ liftLit int2FloatLit ] - Double2IntOp -> mkPrimOpRule nm 1 [ liftLit double2IntLit ] - Int2DoubleOp -> mkPrimOpRule nm 1 [ liftLit int2DoubleLit ] + FloatToIntOp -> mkPrimOpRule nm 1 [ liftLit floatToIntLit ] + IntToFloatOp -> mkPrimOpRule nm 1 [ liftLit intToFloatLit ] + DoubleToIntOp -> mkPrimOpRule nm 1 [ liftLit doubleToIntLit ] + IntToDoubleOp -> mkPrimOpRule nm 1 [ liftLit intToDoubleLit ] -- SUP: Not sure what the standard says about precision in the following 2 cases - Float2DoubleOp -> mkPrimOpRule nm 1 [ liftLit float2DoubleLit ] - Double2FloatOp -> mkPrimOpRule nm 1 [ liftLit double2FloatLit ] + FloatToDoubleOp -> mkPrimOpRule nm 1 [ liftLit floatToDoubleLit ] + DoubleToFloatOp -> mkPrimOpRule nm 1 [ liftLit doubleToFloatLit ] -- Float FloatAddOp -> mkPrimOpRule nm 2 [ binaryLit (floatOp2 (+)) @@ -1364,9 +1364,9 @@ builtinBignumRules _ = , rule_passthrough "Word# -> Integer -> Word#" integerToWordName integerFromWordName , rule_passthrough "Int64# -> Integer -> Int64#" integerToInt64Name integerFromInt64Name , rule_passthrough "Word64# -> Integer -> Word64#" integerToWord64Name integerFromWord64Name - , rule_smallIntegerTo "IS -> Word#" integerToWordName Int2WordOp - , rule_smallIntegerTo "IS -> Float" integerToFloatName Int2FloatOp - , rule_smallIntegerTo "IS -> Double" integerToDoubleName Int2DoubleOp + , rule_smallIntegerTo "IS -> Word#" integerToWordName IntToWordOp + , rule_smallIntegerTo "IS -> Float" integerToFloatName IntToFloatOp + , rule_smallIntegerTo "IS -> Double" integerToDoubleName IntToDoubleOp , rule_passthrough "Word# -> Natural -> Word#" naturalToWordName naturalNSDataConName , rule_IntegerToNaturalClamp "Integer -> Natural (clamp)" integerToNaturalClampName ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -840,9 +840,9 @@ emitPrimOp dflags primop = case primop of emitCtzCall res w (wordWidth platform) -- Unsigned int to floating point conversions - Word2FloatOp -> \[w] -> opIntoRegs $ \[res] -> do + WordToFloatOp -> \[w] -> opIntoRegs $ \[res] -> do emitPrimCall [res] (MO_UF_Conv W32) [w] - Word2DoubleOp -> \[w] -> opIntoRegs $ \[res] -> do + WordToDoubleOp -> \[w] -> opIntoRegs $ \[res] -> do emitPrimCall [res] (MO_UF_Conv W64) [w] -- Atomic operations @@ -1056,10 +1056,10 @@ emitPrimOp dflags primop = case primop of -- The rest just translate straightforwardly - Int2WordOp -> \args -> opNop args - Word2IntOp -> \args -> opNop args - Int2AddrOp -> \args -> opNop args - Addr2IntOp -> \args -> opNop args + IntToWordOp -> \args -> opNop args + WordToIntOp -> \args -> opNop args + IntToAddrOp -> \args -> opNop args + AddrToIntOp -> \args -> opNop args ChrOp -> \args -> opNop args -- Int# and Char# are rep'd the same OrdOp -> \args -> opNop args @@ -1309,14 +1309,14 @@ emitPrimOp dflags primop = case primop of -- Conversions - Int2DoubleOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W64) - Double2IntOp -> \args -> opTranslate args (MO_FS_Conv W64 (wordWidth platform)) + IntToDoubleOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W64) + DoubleToIntOp -> \args -> opTranslate args (MO_FS_Conv W64 (wordWidth platform)) - Int2FloatOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W32) - Float2IntOp -> \args -> opTranslate args (MO_FS_Conv W32 (wordWidth platform)) + IntToFloatOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W32) + FloatToIntOp -> \args -> opTranslate args (MO_FS_Conv W32 (wordWidth platform)) - Float2DoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64) - Double2FloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32) + FloatToDoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64) + DoubleToFloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32) -- Word comparisons masquerading as more exotic things. ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -39,13 +39,13 @@ module GHC.Types.Literal , litValue, isLitValue, isLitValue_maybe, mapLitValue -- ** Coercions - , word2IntLit, int2WordLit + , wordToIntLit, intToWordLit , narrowLit , narrow8IntLit, narrow16IntLit, narrow32IntLit , narrow8WordLit, narrow16WordLit, narrow32WordLit - , char2IntLit, int2CharLit - , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit - , nullAddrLit, rubbishLit, float2DoubleLit, double2FloatLit + , charToIntLit, intToCharLit + , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit + , nullAddrLit, rubbishLit, floatToDoubleLit, doubleToFloatLit ) where #include "HsVersions.h" @@ -474,27 +474,27 @@ isLitValue = isJust . isLitValue_maybe narrow8IntLit, narrow16IntLit, narrow32IntLit, narrow8WordLit, narrow16WordLit, narrow32WordLit, - char2IntLit, int2CharLit, - float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit, - float2DoubleLit, double2FloatLit + charToIntLit, intToCharLit, + floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit, + floatToDoubleLit, doubleToFloatLit :: Literal -> Literal -word2IntLit, int2WordLit :: Platform -> Literal -> Literal -word2IntLit platform (LitNumber LitNumWord w) +wordToIntLit, intToWordLit :: Platform -> Literal -> Literal +wordToIntLit platform (LitNumber LitNumWord w) -- Map Word range [max_int+1, max_word] -- to Int range [min_int , -1] -- Range [0,max_int] has the same representation with both Int and Word | w > platformMaxInt platform = mkLitInt platform (w - platformMaxWord platform - 1) | otherwise = mkLitInt platform w -word2IntLit _ l = pprPanic "word2IntLit" (ppr l) +wordToIntLit _ l = pprPanic "wordToIntLit" (ppr l) -int2WordLit platform (LitNumber LitNumInt i) +intToWordLit platform (LitNumber LitNumInt i) -- Map Int range [min_int , -1] -- to Word range [max_int+1, max_word] -- Range [0,max_int] has the same representation with both Int and Word | i < 0 = mkLitWord platform (1 + platformMaxWord platform + i) | otherwise = mkLitWord platform i -int2WordLit _ l = pprPanic "int2WordLit" (ppr l) +intToWordLit _ l = pprPanic "intToWordLit" (ppr l) -- | Narrow a literal number (unchecked result range) narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal @@ -508,25 +508,25 @@ narrow8WordLit = narrowLit (Proxy :: Proxy Word8) narrow16WordLit = narrowLit (Proxy :: Proxy Word16) narrow32WordLit = narrowLit (Proxy :: Proxy Word32) -char2IntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c)) -char2IntLit l = pprPanic "char2IntLit" (ppr l) -int2CharLit (LitNumber _ i) = LitChar (chr (fromInteger i)) -int2CharLit l = pprPanic "int2CharLit" (ppr l) - -float2IntLit (LitFloat f) = mkLitIntUnchecked (truncate f) -float2IntLit l = pprPanic "float2IntLit" (ppr l) -int2FloatLit (LitNumber _ i) = LitFloat (fromInteger i) -int2FloatLit l = pprPanic "int2FloatLit" (ppr l) - -double2IntLit (LitDouble f) = mkLitIntUnchecked (truncate f) -double2IntLit l = pprPanic "double2IntLit" (ppr l) -int2DoubleLit (LitNumber _ i) = LitDouble (fromInteger i) -int2DoubleLit l = pprPanic "int2DoubleLit" (ppr l) - -float2DoubleLit (LitFloat f) = LitDouble f -float2DoubleLit l = pprPanic "float2DoubleLit" (ppr l) -double2FloatLit (LitDouble d) = LitFloat d -double2FloatLit l = pprPanic "double2FloatLit" (ppr l) +charToIntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c)) +charToIntLit l = pprPanic "charToIntLit" (ppr l) +intToCharLit (LitNumber _ i) = LitChar (chr (fromInteger i)) +intToCharLit l = pprPanic "intToCharLit" (ppr l) + +floatToIntLit (LitFloat f) = mkLitIntUnchecked (truncate f) +floatToIntLit l = pprPanic "floatToIntLit" (ppr l) +intToFloatLit (LitNumber _ i) = LitFloat (fromInteger i) +intToFloatLit l = pprPanic "intToFloatLit" (ppr l) + +doubleToIntLit (LitDouble f) = mkLitIntUnchecked (truncate f) +doubleToIntLit l = pprPanic "doubleToIntLit" (ppr l) +intToDoubleLit (LitNumber _ i) = LitDouble (fromInteger i) +intToDoubleLit l = pprPanic "intToDoubleLit" (ppr l) + +floatToDoubleLit (LitFloat f) = LitDouble f +floatToDoubleLit l = pprPanic "floatToDoubleLit" (ppr l) +doubleToFloatLit (LitDouble d) = LitFloat d +doubleToFloatLit l = pprPanic "doubleToFloatLit" (ppr l) nullAddrLit :: Literal nullAddrLit = LitNullAddr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1b8b1e21c4185acc29db99b76d2c9705b44c3ec -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1b8b1e21c4185acc29db99b76d2c9705b44c3ec You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 04:00:29 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Tue, 08 Sep 2020 00:00:29 -0400 Subject: [Git][ghc/ghc][wip/int64-everywhere] 9 commits: Use "to" instead of "2" in internal names of conversion ops Message-ID: <5f5701dde6d4d_80b6d3a3f010995622@gitlab.haskell.org.mail> John Ericson pushed to branch wip/int64-everywhere at Glasgow Haskell Compiler / GHC Commits: c1b8b1e2 by John Ericson at 2020-09-07T23:58:03-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - d667cd08 by John Ericson at 2020-09-07T23:59:36-04:00 Make fixed-size `Int32#` and `Int64#` The boxed Int64 uses Int64#, but Int32# still uses Int#. The 32-bit case is less pressing to change because it is not a source of brittle CPP---it is the same thing on all platforms. We need Int64/Word64 constant folding to avoid the let/app restriction on Core, so that is implemented now. 32-bit constant unfolding and 32-bit literals are left as follow-up. This is the bulk of #11953 ghc-bignum: add support for Word64#/Int64# on 64-bit arch Fix fingerprint Core generation Fix some tests Co-authored-by: Sylvain Henry <hsyl20 at gmail.com> - - - - - cb772b76 by John Ericson at 2020-09-07T23:59:36-04:00 Inline INT64 and WORD64 macros in primops.txt.pp The definition is now unconditional so there is no reason for that CPP. - - - - - a8a352fb by Sylvain Henry at 2020-09-07T23:59:36-04:00 Fix toArgRep - - - - - dc8d3c23 by Sylvain Henry at 2020-09-07T23:59:36-04:00 Adapt rules from #16402 to Word64#/Int64# - - - - - 90bff3d9 by John Ericson at 2020-09-07T23:59:36-04:00 Copy enumFrom* implementations from Int/Word for Int64/Word64 Without this, we don't get proper list fusion. I think this sort of copying is OK for now, but we absolutely need something better if we are going to make `IntN` use `IntN#` for all `N`. The degree to which proper metaprogramming has been punted upon by factoring everything through the native-sized types is disconcerting. - - - - - ff154b09 by John Ericson at 2020-09-07T23:59:36-04:00 `integerFromInt64#` can be inlined when the word size is >= 64 bits Maybe this will help with the renaming test failure? - - - - - 24feaca2 by John Ericson at 2020-09-07T23:59:36-04:00 Add builtin rule for `divInt64#` and `modInt64#` - - - - - f0b0f83f by John Ericson at 2020-09-07T23:59:36-04:00 WIP: Add missing floats <-> int/word 64 rule and primops - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/CPrim.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Layout.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Utils/Outputable.hs - includes/stg/Prim.h - libraries/base/GHC/Exts.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Float/ConversionUtils.hs - libraries/base/GHC/Float/RealFracMethods.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Integer.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c7f5d578e9eba7738173f1534a3f81c3faeab65...f0b0f83fd9f789bca8407badab70f1792aa1854e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2c7f5d578e9eba7738173f1534a3f81c3faeab65...f0b0f83fd9f789bca8407badab70f1792aa1854e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 09:01:38 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Sep 2020 05:01:38 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: testsuite: Output performance test results in tabular format Message-ID: <5f5748723bfd0_80b3f845834597411012031@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 7d4ceae9 by Daishi Nakajima at 2020-09-08T05:01:28-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 0e4b1fd1 by Ryan Scott at 2020-09-08T05:01:28-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 34110588 by Ben Gamari at 2020-09-08T05:01:28-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - 3633280a by Ben Gamari at 2020-09-08T05:01:28-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - ae817057 by Alan Zimmerman at 2020-09-08T05:01:29-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Closes #18639 - - - - - 27 changed files: - .gitlab/ci.sh - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Expr.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Tc/Gen/Expr.hs - docs/users_guide/exts/explicit_forall.rst - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - testsuite/driver/testutil.py - + testsuite/tests/dependent/should_compile/T18660.hs - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/ghc-api/annotations/T10313.stdout - testsuite/tests/ghc-api/annotations/T11430.stdout - testsuite/tests/ghc-api/annotations/Test10313.hs - testsuite/tests/ghc-api/annotations/Test11430.hs - testsuite/tests/ghc-api/annotations/stringSource.hs - testsuite/tests/ghc-api/annotations/t11430.hs - testsuite/tests/printer/Makefile - − testsuite/tests/printer/Ppr047.hs - testsuite/tests/printer/all.T - utils/haddock Changes: ===================================== .gitlab/ci.sh ===================================== @@ -58,6 +58,12 @@ function run() { TOP="$(pwd)" function setup_locale() { + # Musl doesn't provide locale support at all... + if ! which locale > /dev/null; then + info "No locale executable. Skipping locale setup..." + return + fi + # BSD grep terminates early with -q, consequently locale -a will get a # SIGPIPE and the pipeline will fail with pipefail. shopt -o -u pipefail @@ -70,6 +76,9 @@ function setup_locale() { elif locale -a | grep -q en_US.UTF-8; then # Centos doesn't have C.UTF-8 export LANG=en_US.UTF-8 + elif locale -a | grep -q en_US.utf8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.utf8 else error "Failed to find usable locale" info "Available locales:" ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -838,21 +838,10 @@ data HsPragE p -- 'GHC.Parser.Annotation.AnnVal', -- 'GHC.Parser.Annotation.AnnClose' @'\#-}'@ - -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsPragTick -- A pragma introduced tick - (XTickPragma p) - SourceText -- Note [Pragma source text] in GHC.Types.Basic - (StringLiteral,(Int,Int),(Int,Int)) - -- external span for this tick - ((SourceText,SourceText),(SourceText,SourceText)) - -- Source text for the four integers used in the span. - -- See note [Pragma source text] in GHC.Types.Basic - | XHsPragE !(XXPragE p) type instance XSCC (GhcPass _) = NoExtField type instance XCoreAnn (GhcPass _) = NoExtField -type instance XTickPragma (GhcPass _) = NoExtField type instance XXPragE (GhcPass _) = NoExtCon -- | Located Haskell Tuple Argument @@ -1402,13 +1391,6 @@ instance Outputable (HsPragE (GhcPass p)) where -- no doublequotes if stl empty, for the case where the SCC was written -- without quotes. <+> pprWithSourceText stl (ftext lbl) <+> text "#-}" - ppr (HsPragTick _ st (StringLiteral sta s, (v1,v2), (v3,v4)) ((s1,s2),(s3,s4))) = - pprWithSourceText st (text "{-# GENERATED") - <+> pprWithSourceText sta (doubleQuotes $ ftext s) - <+> pprWithSourceText s1 (ppr v1) <+> char ':' <+> pprWithSourceText s2 (ppr v2) - <+> char '-' - <+> pprWithSourceText s3 (ppr v3) <+> char ':' <+> pprWithSourceText s4 (ppr v4) - <+> text "#-}" {- ************************************************************************ ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Hs.Type ( mkEmptyImplicitBndrs, mkEmptyWildCardBndrs, mkHsForAllVisTele, mkHsForAllInvisTele, mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, - isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy, + isHsKindedTyVar, hsTvbAllKinded, isLHsInvisForAllTy, hsScopedTvs, hsWcScopedTvs, dropWildCards, hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames, @@ -1278,9 +1278,12 @@ ignoreParens :: LHsType (GhcPass p) -> LHsType (GhcPass p) ignoreParens (L _ (HsParTy _ ty)) = ignoreParens ty ignoreParens ty = ty -isLHsForAllTy :: LHsType (GhcPass p) -> Bool -isLHsForAllTy (L _ (HsForAllTy {})) = True -isLHsForAllTy _ = False +-- | Is this type headed by an invisible @forall@? This is used to determine +-- if the type variables in a type should be implicitly quantified. +-- See @Note [forall-or-nothing rule]@ in "GHC.Rename.HsType". +isLHsInvisForAllTy :: LHsType (GhcPass p) -> Bool +isLHsInvisForAllTy (L _ (HsForAllTy{hst_tele = HsForAllInvis{}})) = True +isLHsInvisForAllTy _ = False {- ************************************************************************ ===================================== compiler/GHC/HsToCore/Coverage.hs ===================================== @@ -618,10 +618,6 @@ addTickHsExpr (HsTick x t e) = addTickHsExpr (HsBinTick x t0 t1 e) = liftM (HsBinTick x t0 t1) (addTickLHsExprNever e) -addTickHsExpr (HsPragE _ HsPragTick{} (L pos e0)) = do - e2 <- allocTickBox (ExpBox False) False False pos $ - addTickHsExpr e0 - return $ unLoc e2 addTickHsExpr (HsPragE x p e) = liftM (HsPragE x p) (addTickLHsExpr e) addTickHsExpr e@(HsBracket {}) = return e ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -820,11 +820,6 @@ ds_prag_expr (HsPragSCC _ _ cc) expr = do Tick (ProfNote (mkUserCC nm mod_name (getLoc expr) flavour) count True) <$> dsLExpr expr else dsLExpr expr -ds_prag_expr (HsPragTick _ _ _ _) expr = do - dflags <- getDynFlags - if gopt Opt_Hpc dflags - then panic "dsExpr:HsPragTick" - else dsLExpr expr ------------------------------ dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1572,7 +1572,6 @@ repE (HsUnboundVar _ uv) = do repUnboundVar sname repE (XExpr (HsExpanded _ b)) = repE b repE e@(HsPragE _ HsPragSCC {} _) = notHandled "Cost centres" (ppr e) -repE e@(HsPragE _ HsPragTick {} _) = notHandled "Tick Pragma" (ppr e) repE e = notHandled "Expression form" (ppr e) ----------------------------------------------------------------------------- ===================================== compiler/GHC/Parser.y ===================================== @@ -514,7 +514,6 @@ are the most common patterns, rewritten as regular expressions for clarity: '{-# SOURCE' { L _ (ITsource_prag _) } '{-# RULES' { L _ (ITrules_prag _) } '{-# SCC' { L _ (ITscc_prag _)} - '{-# GENERATED' { L _ (ITgenerated_prag _) } '{-# DEPRECATED' { L _ (ITdeprecated_prag _) } '{-# WARNING' { L _ (ITwarning_prag _) } '{-# UNPACK' { L _ (ITunpack_prag _) } @@ -2525,8 +2524,7 @@ optSemi :: { ([Located Token],Bool) } {- Note [Pragmas and operator fixity] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -'prag_e' is an expression pragma, such as {-# SCC ... #-} or -{-# GENERATED ... #-}. +'prag_e' is an expression pragma, such as {-# SCC ... #-}. It must be used with care, or else #15730 happens. Consider this infix expression: @@ -2580,20 +2578,6 @@ prag_e :: { Located ([AddAnn], HsPragE GhcPs) } HsPragSCC noExtField (getSCC_PRAGs $1) (StringLiteral NoSourceText (getVARID $2))) } - | '{-# GENERATED' STRING INTEGER ':' INTEGER HYPHEN INTEGER ':' INTEGER '#-}' - { let getINT = fromInteger . il_value . getINTEGER in - sLL $1 $> $ ([mo $1,mj AnnVal $2 - ,mj AnnVal $3,mj AnnColon $4 - ,mj AnnVal $5] ++ $6 ++ - [mj AnnVal $7,mj AnnColon $8 - ,mj AnnVal $9,mc $10], - HsPragTick noExtField - (getGENERATED_PRAGs $1) - (getStringLiteral $2, - (getINT $3, getINT $5), - (getINT $7, getINT $9)) - ((getINTEGERs $3, getINTEGERs $5), - (getINTEGERs $7, getINTEGERs $9) )) } fexp :: { ECP } : fexp aexp { ECP $ superFunArg $ @@ -3700,7 +3684,6 @@ getRULES_PRAGs (L _ (ITrules_prag src)) = src getWARNING_PRAGs (L _ (ITwarning_prag src)) = src getDEPRECATED_PRAGs (L _ (ITdeprecated_prag src)) = src getSCC_PRAGs (L _ (ITscc_prag src)) = src -getGENERATED_PRAGs (L _ (ITgenerated_prag src)) = src getUNPACK_PRAGs (L _ (ITunpack_prag src)) = src getNOUNPACK_PRAGs (L _ (ITnounpack_prag src)) = src getANN_PRAGs (L _ (ITann_prag src)) = src ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -743,7 +743,6 @@ data Token | ITline_prag SourceText -- not usually produced, see 'UsePosPragsBit' | ITcolumn_prag SourceText -- not usually produced, see 'UsePosPragsBit' | ITscc_prag SourceText - | ITgenerated_prag SourceText | ITunpack_prag SourceText | ITnounpack_prag SourceText | ITann_prag SourceText @@ -3289,7 +3288,6 @@ oneWordPrags = Map.fromList [ ("warning", strtoken (\s -> ITwarning_prag (SourceText s))), ("deprecated", strtoken (\s -> ITdeprecated_prag (SourceText s))), ("scc", strtoken (\s -> ITscc_prag (SourceText s))), - ("generated", strtoken (\s -> ITgenerated_prag (SourceText s))), ("unpack", strtoken (\s -> ITunpack_prag (SourceText s))), ("nounpack", strtoken (\s -> ITnounpack_prag (SourceText s))), ("ann", strtoken (\s -> ITann_prag (SourceText s))), ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -243,7 +243,6 @@ rnExpr (HsPragE x prag expr) where rn_prag :: HsPragE GhcPs -> HsPragE GhcRn rn_prag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann - rn_prag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo rnExpr (HsLam x matches) = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -168,7 +168,7 @@ rn_hs_sig_wc_type scoping ctxt hs_ty thing_inside ; let nwc_rdrs = nubL nwc_rdrs' ; implicit_bndrs <- case scoping of AlwaysBind -> pure tv_rdrs - BindUnlessForall -> forAllOrNothing (isLHsForAllTy hs_ty) tv_rdrs + BindUnlessForall -> forAllOrNothing (isLHsInvisForAllTy hs_ty) tv_rdrs NeverBind -> pure [] ; rnImplicitBndrs Nothing implicit_bndrs $ \ vars -> do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty @@ -321,7 +321,7 @@ rnHsSigType :: HsDocContext rnHsSigType ctx level (HsIB { hsib_body = hs_ty }) = do { traceRn "rnHsSigType" (ppr hs_ty) ; rdr_env <- getLocalRdrEnv - ; vars0 <- forAllOrNothing (isLHsForAllTy hs_ty) + ; vars0 <- forAllOrNothing (isLHsInvisForAllTy hs_ty) $ filterInScope rdr_env $ extractHsTyRdrTyVars hs_ty ; rnImplicitBndrs Nothing vars0 $ \ vars -> @@ -331,17 +331,43 @@ rnHsSigType ctx level (HsIB { hsib_body = hs_ty }) , hsib_body = body' } , fvs ) } } --- Note [forall-or-nothing rule] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Free variables in signatures are usually bound in an implicit --- 'forall' at the beginning of user-written signatures. However, if the --- signature has an explicit forall at the beginning, this is disabled. --- --- The idea is nested foralls express something which is only --- expressible explicitly, while a top level forall could (usually) be --- replaced with an implicit binding. Top-level foralls alone ("forall.") are --- therefore an indication that the user is trying to be fastidious, so --- we don't implicitly bind any variables. +{- +Note [forall-or-nothing rule] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Free variables in signatures are usually bound in an implicit 'forall' at the +beginning of user-written signatures. However, if the signature has an +explicit, invisible forall at the beginning, this is disabled. + +The idea is nested foralls express something which is only expressible +explicitly, while a top level forall could (usually) be replaced with an +implicit binding. Top-level foralls alone ("forall.") are therefore an +indication that the user is trying to be fastidious, so we don't implicitly +bind any variables. + +Note that this rule only applies to outermost /in/visible 'forall's, and not +outermost visible 'forall's. See #18660 for more on this point. + +Here are some concrete examples to demonstrate the forall-or-nothing rule in +action: + + type F1 :: a -> b -> b -- Legal; a,b are implicitly quantified. + -- Equivalently: forall a b. a -> b -> b + + type F2 :: forall a b. a -> b -> b -- Legal; explicitly quantified + + type F3 :: forall a. a -> b -> b -- Illegal; the forall-or-nothing rule says that + -- if you quantify a, you must also quantify b + + type F4 :: forall a -> b -> b -- Legal; the top quantifier (forall a) is a /visible/ + -- quantifer, so the "nothing" part of the forall-or-nothing + -- rule applies, and b is therefore implicitly quantified. + -- Equivalently: forall b. forall a -> b -> b + + type F5 :: forall b. forall a -> b -> c -- Illegal; the forall-or-nothing rule says that + -- if you quantify b, you must also quantify c + + type F6 :: forall a -> forall b. b -> c -- Legal: just like F4. +-} -- | See @Note [forall-or-nothing rule]@. This tiny little function is used -- (rather than its small body inlined) to indicate that we are implementing ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1082,7 +1082,6 @@ tcExpr other _ = pprPanic "tcLExpr" (ppr other) tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc tcExprPrag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann -tcExprPrag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo {- ********************************************************************* ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -56,30 +56,32 @@ The ``forall``-or-nothing rule ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In certain forms of types, type variables obey what is known as the -"``forall``-or-nothing" rule: if a type has an outermost, explicit -``forall``, then all of the type variables in the type must be explicitly -quantified. These two examples illustrate how the rule works: :: +"``forall``-or-nothing" rule: if a type has an outermost, explicit, +invisible ``forall``, then all of the type variables in the type must be +explicitly quantified. These two examples illustrate how the rule works: :: f :: forall a b. a -> b -> b -- OK, `a` and `b` are explicitly bound g :: forall a. a -> forall b. b -> b -- OK, `a` and `b` are explicitly bound h :: forall a. a -> b -> b -- Rejected, `b` is not in scope The type signatures for ``f``, ``g``, and ``h`` all begin with an outermost -``forall``, so every type variable in these signatures must be explicitly -bound by a ``forall``. Both ``f`` and ``g`` obey the ``forall``-or-nothing -rule, since they explicitly quantify ``a`` and ``b``. On the other hand, -``h`` does not explicitly quantify ``b``, so GHC will reject its type -signature for being improperly scoped. +invisible ``forall``, so every type variable in these signatures must be +explicitly bound by a ``forall``. Both ``f`` and ``g`` obey the +``forall``-or-nothing rule, since they explicitly quantify ``a`` and ``b``. On +the other hand, ``h`` does not explicitly quantify ``b``, so GHC will reject +its type signature for being improperly scoped. In places where the ``forall``-or-nothing rule takes effect, if a type does -*not* have an outermost ``forall``, then any type variables that are not -explicitly bound by a ``forall`` become implicitly quantified. For example: :: +*not* have an outermost invisible ``forall``, then any type variables that are +not explicitly bound by a ``forall`` become implicitly quantified. For example: :: i :: a -> b -> b -- `a` and `b` are implicitly quantified j :: a -> forall b. b -> b -- `a` is implicitly quantified k :: (forall a. a -> b -> b) -- `b` is implicitly quantified + type L :: forall a -> b -> b -- `b` is implicitly quantified -GHC will accept ``i``, ``j``, and ``k``'s type signatures. Note that: +GHC will accept ``i``, ``j``, and ``k``'s type signatures, as well as ``L``'s +kind signature. Note that: - ``j``'s signature is accepted despite its mixture of implicit and explicit quantification. As long as a ``forall`` is not an outermost one, it is fine @@ -88,6 +90,9 @@ GHC will accept ``i``, ``j``, and ``k``'s type signatures. Note that: the ``forall`` is not an outermost ``forall``. The ``forall``-or-nothing rule is one of the few places in GHC where the presence or absence of parentheses can be semantically significant! +- ``L``'s signature begins with an outermost ``forall``, but it is a *visible* + ``forall``, not an invisible ``forall``, and therefore does not trigger the + ``forall``-or-nothing rule. The ``forall``-or-nothing rule takes effect in the following places: ===================================== testsuite/driver/perf_notes.py ===================================== @@ -22,7 +22,7 @@ import sys from collections import namedtuple from math import ceil, trunc -from testutil import passed, failBecause, testing_metrics +from testutil import passed, failBecause, testing_metrics, print_table from term_color import Color, colored from my_typing import * @@ -45,6 +45,14 @@ def inside_git_repo() -> bool: def is_worktree_dirty() -> bool: return subprocess.check_output(['git', 'status', '--porcelain']) != b'' +# Get length of abbreviated git commit hash +def get_abbrev_hash_length() -> int: + try: + return len(subprocess.check_output(['git', 'rev-parse', + '--short', 'HEAD']).strip()) + except subprocess.CalledProcessError: + return 10 + # # Some data access functions. At the moment this uses git notes. # @@ -100,6 +108,15 @@ class MetricChange(Enum): } return strings[self] + def short_name(self): + strings = { + MetricChange.NewMetric: "new", + MetricChange.NoChange: "unch", + MetricChange.Increase: "incr", + MetricChange.Decrease: "decr" + } + return strings[self] + AllowedPerfChange = NamedTuple('AllowedPerfChange', [('direction', MetricChange), ('metrics', List[str]), @@ -758,7 +775,7 @@ def main() -> None: exit(0) # - # String utilities for pretty-printing + # Print the data in tablular format # # T1234 T1234 @@ -770,11 +787,12 @@ def main() -> None: # HEAD~1 10023 10023 # HEAD~2 21234 21234 # HEAD~3 20000 20000 - - # Data is already in colum major format, so do that, calculate column widths - # then transpose and print each row. def strMetric(x): return '{:.2f}'.format(x.value) if x != None else "" + # Data is in colum major format, so transpose and pass to print_table. + T = TypeVar('T') + def transpose(xss: List[List[T]]) -> List[List[T]]: + return list(map(list, zip(*xss))) headerCols = [ ["","","","Commit"] ] \ + [ [name, metric, way, env] for (env, name, metric, way) in testSeries ] @@ -782,17 +800,7 @@ def main() -> None: + [ [strMetric(get_commit_metric(ref, commit, env, name, metric, way)) \ for commit in commits ] \ for (env, name, metric, way) in testSeries ] - colWidths = [max([2+len(cell) for cell in colH + colD]) for (colH,colD) in zip(headerCols, dataCols)] - col_fmts = ['{:>' + str(w) + '}' for w in colWidths] - - def printCols(cols): - for row in zip(*cols): - # print(list(zip(col_fmts, row))) - print(''.join([f.format(cell) for (f,cell) in zip(col_fmts, row)])) - - printCols(headerCols) - print('-'*(sum(colWidths)+2)) - printCols(dataCols) + print_table(transpose(headerCols), transpose(dataCols)) if __name__ == '__main__': main() ===================================== testsuite/driver/runtests.py ===================================== @@ -23,11 +23,11 @@ import traceback # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import getStdout, Watcher, str_warn, str_info +from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \ TestOptions, brokens, PerfMetric from my_typing import TestName -from perf_notes import MetricChange, GitRef, inside_git_repo, is_worktree_dirty, format_perf_stat +from perf_notes import MetricChange, GitRef, inside_git_repo, is_worktree_dirty, format_perf_stat, get_abbrev_hash_length, is_commit_hash from junit import junit import term_color from term_color import Color, colored @@ -341,23 +341,52 @@ def cleanup_and_exit(exitcode): exit(exitcode) def tabulate_metrics(metrics: List[PerfMetric]) -> None: - for metric in sorted(metrics, key=lambda m: (m.stat.test, m.stat.way, m.stat.metric)): - print("{test:24} {metric:40} {value:15.3f}".format( - test = "{}({})".format(metric.stat.test, metric.stat.way), - metric = metric.stat.metric, - value = metric.stat.value - )) - if metric.baseline is not None: - val0 = metric.baseline.perfStat.value - val1 = metric.stat.value - rel = 100 * (val1 - val0) / val0 - print("{space:24} {herald:40} {value:15.3f} [{direction}, {rel:2.1f}%]".format( - space = "", - herald = "(baseline @ {commit})".format( - commit = metric.baseline.commit), - value = val0, - direction = metric.change, - rel = rel + abbrevLen = get_abbrev_hash_length() + hasBaseline = any([x.baseline is not None for x in metrics]) + baselineCommitSet = set([x.baseline.commit for x in metrics if x.baseline is not None]) + hideBaselineCommit = not hasBaseline or len(baselineCommitSet) == 1 + hideBaselineEnv = not hasBaseline or all( + [x.stat.test_env == x.baseline.perfStat.test_env + for x in metrics if x.baseline is not None]) + def row(cells: Tuple[str, str, str, str, str, str, str]) -> List[str]: + return [x for (idx, x) in enumerate(list(cells)) if + (idx != 2 or not hideBaselineCommit) and + (idx != 3 or not hideBaselineEnv )] + + headerRows = [ + row(("", "", "Baseline", "Baseline", "Baseline", "", "")), + row(("Test", "Metric", "commit", "environment", "value", "New value", "Change")) + ] + def strDiff(x: PerfMetric) -> str: + if x.baseline is None: + return "" + val0 = x.baseline.perfStat.value + val1 = x.stat.value + return "{}({:+2.1f}%)".format(x.change.short_name(), 100 * (val1 - val0) / val0) + dataRows = [row(( + "{}({})".format(x.stat.test, x.stat.way), + shorten_metric_name(x.stat.metric), + "{}".format(x.baseline.commit[:abbrevLen] + if is_commit_hash(x.baseline.commit) else x.baseline.commit) + if x.baseline is not None else "", + "{}".format(x.baseline.perfStat.test_env) + if x.baseline is not None else "", + "{:13.1f}".format(x.baseline.perfStat.value) + if x.baseline is not None else "", + "{:13.1f}".format(x.stat.value), + strDiff(x) + )) for x in sorted(metrics, key = + lambda m: (m.stat.test, m.stat.way, m.stat.metric))] + print_table(headerRows, dataRows, 1) + print("") + if hasBaseline: + if hideBaselineEnv: + print("* All baselines were measured in the same environment as this test run") + if hideBaselineCommit: + commit = next(iter(baselineCommitSet)) + print("* All baseline commits are {}".format( + commit[:abbrevLen] + if is_commit_hash(commit) else commit )) # First collect all the tests to be run ===================================== testsuite/driver/testutil.py ===================================== @@ -144,3 +144,29 @@ def memoize(f): cached._cache = None return cached + +# Print the matrix data in a tabular format. +def print_table(header_rows: List[List[str]], data_rows: List[List[str]], padding=2) -> None: + # Calculate column widths then print each row. + colWidths = [(0 if idx == 0 else padding) + max([len(cell) for cell in col]) + for (idx, col) in enumerate(zip(*(header_rows + data_rows)))] + col_fmts = ['{:>' + str(w) + '}' for w in colWidths] + + def printCols(cols): + for row in cols: + print(''.join([f.format(cell) for (f,cell) in zip(col_fmts, row)])) + + printCols(header_rows) + print('-' * sum(colWidths)) + printCols(data_rows) + +def shorten_metric_name(name: str) -> str: + dic = { + "runtime/bytes allocated": "run/alloc", + "runtime/peak_megabytes_allocated": "run/peak", + "runtime/max_bytes_used": "run/max", + "compile_time/bytes allocated": "ghc/alloc", + "compile_time/peak_megabytes_allocated": "ghc/peak", + "compile_time/max_bytes_used": "ghc/max", + } + return dic.get(name, name) ===================================== testsuite/tests/dependent/should_compile/T18660.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T18660 where + +type F :: forall a -> b -> b +type F x y = y ===================================== testsuite/tests/dependent/should_compile/all.T ===================================== @@ -66,3 +66,4 @@ test('T16326_Compile2', normal, compile, ['']) test('T16391a', normal, compile, ['']) test('T16344b', normal, compile, ['']) test('T16347', normal, compile, ['']) +test('T18660', normal, compile, ['']) ===================================== testsuite/tests/ghc-api/annotations/T10313.stdout ===================================== @@ -10,5 +10,4 @@ ([c], [(SourceText "foo\x63", fooc), (SourceText "b\x61r", bar)]), ([r], [(SourceText "foo1\x67", foo1g)]), ([s, t], [(SourceText "a\x62", ab)]), - ([s, c], [(SourceText "foo\x64", food)]), - ([t, p], [(SourceText "foob\x61r", foobar)])] + ([s, c], [(SourceText "foo\x64", food)])] ===================================== testsuite/tests/ghc-api/annotations/T11430.stdout ===================================== @@ -3,4 +3,3 @@ ("ia",["1"]) ("ia",["0x999"]) ("ia",["1"]) -("tp",["((SourceText \"0x1\",SourceText \"0x2\"),(SourceText \"0x3\",SourceText \"0x4\"))"]) ===================================== testsuite/tests/ghc-api/annotations/Test10313.hs ===================================== @@ -33,5 +33,3 @@ strictStream (Bitstream l v) Exact l b = {-# SCC "foo\x64" #-} 006 - -c = {-# GENERATED "foob\x61r" 1 : 2 - 3 : 4 #-} 0.00 ===================================== testsuite/tests/ghc-api/annotations/Test11430.hs ===================================== @@ -21,5 +21,3 @@ x = undefined {-# INLINABLE [1] y #-} y :: (Num a, Integral b) => a -> b -> a y = undefined - -c = {-# GENERATED "foob\x61r" 0x1 : 0x2 - 0x3 : 0x4 #-} 0.00 ===================================== testsuite/tests/ghc-api/annotations/stringSource.hs ===================================== @@ -86,7 +86,6 @@ testOneFile libdir fileName = do doPragE :: HsPragE GhcPs -> [(String,[Located (SourceText,FastString)])] doPragE (HsPragSCC _ src ss) = [("sc",[conv (noLoc ss)])] - doPragE (HsPragTick _ src (ss,_,_) _ss2) = [("tp",[conv (noLoc ss)])] conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs) ===================================== testsuite/tests/ghc-api/annotations/t11430.hs ===================================== @@ -68,7 +68,6 @@ testOneFile libdir fileName = do doRuleDecl (HsRule _ _ _ _ _ _ _) = [] doHsExpr :: HsExpr GhcPs -> [(String,[String])] - doHsExpr (HsPragE _ (HsPragTick _ src (_,_,_) ss) _) = [("tp",[show ss])] doHsExpr _ = [] doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _) ===================================== testsuite/tests/printer/Makefile ===================================== @@ -190,10 +190,6 @@ ppr045: ppr046: $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr046.hs -.PHONY: ppr047 -ppr047: - $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr047.hs - .PHONY: ppr048 ppr048: $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr048.hs ===================================== testsuite/tests/printer/Ppr047.hs deleted ===================================== @@ -1,3 +0,0 @@ -module ExprPragmas where - -c = {-# GENERATED "foobar" 1 : 2 - 3 : 4 #-} 0.00 ===================================== testsuite/tests/printer/all.T ===================================== @@ -44,7 +44,6 @@ test('Ppr043', [ignore_stderr, req_interp], makefile_test, ['ppr043']) test('Ppr044', ignore_stderr, makefile_test, ['ppr044']) test('Ppr045', ignore_stderr, makefile_test, ['ppr045']) test('Ppr046', ignore_stderr, makefile_test, ['ppr046']) -test('Ppr047', ignore_stderr, makefile_test, ['ppr047']) test('Ppr048', ignore_stderr, makefile_test, ['ppr048']) test('T13199', [ignore_stderr, req_interp], makefile_test, ['T13199']) test('T13050p', ignore_stderr, makefile_test, ['T13050p']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 54468d1e60cb10093120137766cfc9dd91671c98 +Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86120f70895932b4a8996ac24e32b1cbd6564e8e...ae81705781fe1646f1c1f862b37cf1905397e8b3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86120f70895932b4a8996ac24e32b1cbd6564e8e...ae81705781fe1646f1c1f862b37cf1905397e8b3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 10:15:25 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Sep 2020 06:15:25 -0400 Subject: [Git][ghc/ghc][wip/T18566] 21 commits: Add HomeUnit type Message-ID: <5f5759bdd442f_80b1017b0141101966f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18566 at Glasgow Haskell Compiler / GHC Commits: ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - bbe81775 by Ben Gamari at 2020-08-21T19:25:18+00:00 IdInfo: Shrink arity fields to 20 bits 30 bits is utter overkill. - - - - - fd8f081a by Ben Gamari at 2020-08-21T19:25:18+00:00 IdInfo: Refactor bit packing logic and shrink arity fields - - - - - cdd88e58 by Ben Gamari at 2020-08-21T19:25:18+00:00 Rename addInlinePrags -> addIdPrags This is going to be slightly generalized. - - - - - d019828b by Ben Gamari at 2020-08-21T19:25:18+00:00 Add CALLER_CC pragma - - - - - de2b9f80 by GHC GitLab CI at 2020-08-21T19:25:18+00:00 hii - - - - - 458c1529 by GHC GitLab CI at 2020-08-29T16:06:23+00:00 Changes - - - - - e8a57252 by GHC GitLab CI at 2020-08-29T19:18:07+00:00 Merge it into the compiler - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC.hs - compiler/GHC/Cmm.hs - compiler/GHC/CmmToAsm.hs - compiler/GHC/CmmToAsm/BlockLayout.hs - compiler/GHC/CmmToAsm/Instr.hs - compiler/GHC/CmmToAsm/Monad.hs - compiler/GHC/CmmToAsm/PIC.hs - + compiler/GHC/CmmToAsm/PPC.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Graph.hs - compiler/GHC/CmmToAsm/Reg/Graph/SpillCost.hs - compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs - compiler/GHC/CmmToAsm/Reg/Linear/Stats.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - + compiler/GHC/CmmToAsm/SPARC.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Expand.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Gen64.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen/Sanity.hs - compiler/GHC/CmmToAsm/SPARC/Instr.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs - + compiler/GHC/CmmToAsm/Types.hs - + compiler/GHC/CmmToAsm/Utils.hs - + compiler/GHC/CmmToAsm/X86.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6c0d6b04f10c861066954fb3b2421f1d881720d...e8a572524d95a6dde3f382983ea302f5b13529c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6c0d6b04f10c861066954fb3b2421f1d881720d...e8a572524d95a6dde3f382983ea302f5b13529c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 11:22:27 2020 From: gitlab at gitlab.haskell.org (Ryan Scott) Date: Tue, 08 Sep 2020 07:22:27 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18648 Message-ID: <5f5769737b4be_80b3f8459d57b3c1103235f@gitlab.haskell.org.mail> Ryan Scott pushed new branch wip/T18648 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18648 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 13:44:05 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Sep 2020 09:44:05 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports2 Message-ID: <5f578aa55e07a_80b3f848c968e1c110593fd@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backports2 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 13:46:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Sep 2020 09:46:47 -0400 Subject: [Git][ghc/ghc][wip/backports2] gitlab-ci: Rename RELEASE variable to RELEASE_JOB Message-ID: <5f578b4732b3b_80b3f848b110270110610ca@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/backports2 at Glasgow Haskell Compiler / GHC Commits: 3e55edd9 by Ben Gamari at 2020-09-08T09:46:42-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. (cherry picked from commit 15dca84793d5ec4ff922726477923e40caa075eb) - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -66,7 +66,7 @@ workflow: when: always expire_in: 1 year rules: - - if: '$RELEASE == "yes"' + - if: '$RELEASE_JOB == "yes"' ############################################################ # Runner Tags View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e55edd97c8eba271f5cb64b9362796791e0e887 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e55edd97c8eba271f5cb64b9362796791e0e887 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 14:32:00 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Sep 2020 10:32:00 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: rts: Add stg_copyArray_barrier to RtsSymbols list Message-ID: <5f5795e0c7e9e_80b3f847c736bcc11071936@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 3805c844 by Ben Gamari at 2020-09-08T10:31:52-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - ccc51e27 by Daishi Nakajima at 2020-09-08T10:31:53-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - c74e8a2e by Ryan Scott at 2020-09-08T10:31:54-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - a7430fab by Ben Gamari at 2020-09-08T10:31:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - dd5196ea by Ben Gamari at 2020-09-08T10:31:54-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - 10 changed files: - .gitlab/ci.sh - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - docs/users_guide/exts/explicit_forall.rst - rts/RtsSymbols.c - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - testsuite/driver/testutil.py - + testsuite/tests/dependent/should_compile/T18660.hs - testsuite/tests/dependent/should_compile/all.T Changes: ===================================== .gitlab/ci.sh ===================================== @@ -58,6 +58,12 @@ function run() { TOP="$(pwd)" function setup_locale() { + # Musl doesn't provide locale support at all... + if ! which locale > /dev/null; then + info "No locale executable. Skipping locale setup..." + return + fi + # BSD grep terminates early with -q, consequently locale -a will get a # SIGPIPE and the pipeline will fail with pipefail. shopt -o -u pipefail @@ -70,6 +76,9 @@ function setup_locale() { elif locale -a | grep -q en_US.UTF-8; then # Centos doesn't have C.UTF-8 export LANG=en_US.UTF-8 + elif locale -a | grep -q en_US.utf8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.utf8 else error "Failed to find usable locale" info "Available locales:" ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Hs.Type ( mkEmptyImplicitBndrs, mkEmptyWildCardBndrs, mkHsForAllVisTele, mkHsForAllInvisTele, mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, - isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy, + isHsKindedTyVar, hsTvbAllKinded, isLHsInvisForAllTy, hsScopedTvs, hsWcScopedTvs, dropWildCards, hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames, @@ -1278,9 +1278,12 @@ ignoreParens :: LHsType (GhcPass p) -> LHsType (GhcPass p) ignoreParens (L _ (HsParTy _ ty)) = ignoreParens ty ignoreParens ty = ty -isLHsForAllTy :: LHsType (GhcPass p) -> Bool -isLHsForAllTy (L _ (HsForAllTy {})) = True -isLHsForAllTy _ = False +-- | Is this type headed by an invisible @forall@? This is used to determine +-- if the type variables in a type should be implicitly quantified. +-- See @Note [forall-or-nothing rule]@ in "GHC.Rename.HsType". +isLHsInvisForAllTy :: LHsType (GhcPass p) -> Bool +isLHsInvisForAllTy (L _ (HsForAllTy{hst_tele = HsForAllInvis{}})) = True +isLHsInvisForAllTy _ = False {- ************************************************************************ ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -168,7 +168,7 @@ rn_hs_sig_wc_type scoping ctxt hs_ty thing_inside ; let nwc_rdrs = nubL nwc_rdrs' ; implicit_bndrs <- case scoping of AlwaysBind -> pure tv_rdrs - BindUnlessForall -> forAllOrNothing (isLHsForAllTy hs_ty) tv_rdrs + BindUnlessForall -> forAllOrNothing (isLHsInvisForAllTy hs_ty) tv_rdrs NeverBind -> pure [] ; rnImplicitBndrs Nothing implicit_bndrs $ \ vars -> do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty @@ -321,7 +321,7 @@ rnHsSigType :: HsDocContext rnHsSigType ctx level (HsIB { hsib_body = hs_ty }) = do { traceRn "rnHsSigType" (ppr hs_ty) ; rdr_env <- getLocalRdrEnv - ; vars0 <- forAllOrNothing (isLHsForAllTy hs_ty) + ; vars0 <- forAllOrNothing (isLHsInvisForAllTy hs_ty) $ filterInScope rdr_env $ extractHsTyRdrTyVars hs_ty ; rnImplicitBndrs Nothing vars0 $ \ vars -> @@ -331,17 +331,43 @@ rnHsSigType ctx level (HsIB { hsib_body = hs_ty }) , hsib_body = body' } , fvs ) } } --- Note [forall-or-nothing rule] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Free variables in signatures are usually bound in an implicit --- 'forall' at the beginning of user-written signatures. However, if the --- signature has an explicit forall at the beginning, this is disabled. --- --- The idea is nested foralls express something which is only --- expressible explicitly, while a top level forall could (usually) be --- replaced with an implicit binding. Top-level foralls alone ("forall.") are --- therefore an indication that the user is trying to be fastidious, so --- we don't implicitly bind any variables. +{- +Note [forall-or-nothing rule] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Free variables in signatures are usually bound in an implicit 'forall' at the +beginning of user-written signatures. However, if the signature has an +explicit, invisible forall at the beginning, this is disabled. + +The idea is nested foralls express something which is only expressible +explicitly, while a top level forall could (usually) be replaced with an +implicit binding. Top-level foralls alone ("forall.") are therefore an +indication that the user is trying to be fastidious, so we don't implicitly +bind any variables. + +Note that this rule only applies to outermost /in/visible 'forall's, and not +outermost visible 'forall's. See #18660 for more on this point. + +Here are some concrete examples to demonstrate the forall-or-nothing rule in +action: + + type F1 :: a -> b -> b -- Legal; a,b are implicitly quantified. + -- Equivalently: forall a b. a -> b -> b + + type F2 :: forall a b. a -> b -> b -- Legal; explicitly quantified + + type F3 :: forall a. a -> b -> b -- Illegal; the forall-or-nothing rule says that + -- if you quantify a, you must also quantify b + + type F4 :: forall a -> b -> b -- Legal; the top quantifier (forall a) is a /visible/ + -- quantifer, so the "nothing" part of the forall-or-nothing + -- rule applies, and b is therefore implicitly quantified. + -- Equivalently: forall b. forall a -> b -> b + + type F5 :: forall b. forall a -> b -> c -- Illegal; the forall-or-nothing rule says that + -- if you quantify b, you must also quantify c + + type F6 :: forall a -> forall b. b -> c -- Legal: just like F4. +-} -- | See @Note [forall-or-nothing rule]@. This tiny little function is used -- (rather than its small body inlined) to indicate that we are implementing ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -56,30 +56,32 @@ The ``forall``-or-nothing rule ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In certain forms of types, type variables obey what is known as the -"``forall``-or-nothing" rule: if a type has an outermost, explicit -``forall``, then all of the type variables in the type must be explicitly -quantified. These two examples illustrate how the rule works: :: +"``forall``-or-nothing" rule: if a type has an outermost, explicit, +invisible ``forall``, then all of the type variables in the type must be +explicitly quantified. These two examples illustrate how the rule works: :: f :: forall a b. a -> b -> b -- OK, `a` and `b` are explicitly bound g :: forall a. a -> forall b. b -> b -- OK, `a` and `b` are explicitly bound h :: forall a. a -> b -> b -- Rejected, `b` is not in scope The type signatures for ``f``, ``g``, and ``h`` all begin with an outermost -``forall``, so every type variable in these signatures must be explicitly -bound by a ``forall``. Both ``f`` and ``g`` obey the ``forall``-or-nothing -rule, since they explicitly quantify ``a`` and ``b``. On the other hand, -``h`` does not explicitly quantify ``b``, so GHC will reject its type -signature for being improperly scoped. +invisible ``forall``, so every type variable in these signatures must be +explicitly bound by a ``forall``. Both ``f`` and ``g`` obey the +``forall``-or-nothing rule, since they explicitly quantify ``a`` and ``b``. On +the other hand, ``h`` does not explicitly quantify ``b``, so GHC will reject +its type signature for being improperly scoped. In places where the ``forall``-or-nothing rule takes effect, if a type does -*not* have an outermost ``forall``, then any type variables that are not -explicitly bound by a ``forall`` become implicitly quantified. For example: :: +*not* have an outermost invisible ``forall``, then any type variables that are +not explicitly bound by a ``forall`` become implicitly quantified. For example: :: i :: a -> b -> b -- `a` and `b` are implicitly quantified j :: a -> forall b. b -> b -- `a` is implicitly quantified k :: (forall a. a -> b -> b) -- `b` is implicitly quantified + type L :: forall a -> b -> b -- `b` is implicitly quantified -GHC will accept ``i``, ``j``, and ``k``'s type signatures. Note that: +GHC will accept ``i``, ``j``, and ``k``'s type signatures, as well as ``L``'s +kind signature. Note that: - ``j``'s signature is accepted despite its mixture of implicit and explicit quantification. As long as a ``forall`` is not an outermost one, it is fine @@ -88,6 +90,9 @@ GHC will accept ``i``, ``j``, and ``k``'s type signatures. Note that: the ``forall`` is not an outermost ``forall``. The ``forall``-or-nothing rule is one of the few places in GHC where the presence or absence of parentheses can be semantically significant! +- ``L``'s signature begins with an outermost ``forall``, but it is a *visible* + ``forall``, not an invisible ``forall``, and therefore does not trigger the + ``forall``-or-nothing rule. The ``forall``-or-nothing rule takes effect in the following places: ===================================== rts/RtsSymbols.c ===================================== @@ -710,6 +710,7 @@ SymI_HasProto(stg_copySmallArrayzh) \ SymI_HasProto(stg_copySmallMutableArrayzh) \ SymI_HasProto(stg_casSmallArrayzh) \ + SymI_HasProto(stg_copyArray_barrier) \ SymI_HasProto(stg_newBCOzh) \ SymI_HasProto(stg_newByteArrayzh) \ SymI_HasProto(stg_casIntArrayzh) \ ===================================== testsuite/driver/perf_notes.py ===================================== @@ -22,7 +22,7 @@ import sys from collections import namedtuple from math import ceil, trunc -from testutil import passed, failBecause, testing_metrics +from testutil import passed, failBecause, testing_metrics, print_table from term_color import Color, colored from my_typing import * @@ -45,6 +45,14 @@ def inside_git_repo() -> bool: def is_worktree_dirty() -> bool: return subprocess.check_output(['git', 'status', '--porcelain']) != b'' +# Get length of abbreviated git commit hash +def get_abbrev_hash_length() -> int: + try: + return len(subprocess.check_output(['git', 'rev-parse', + '--short', 'HEAD']).strip()) + except subprocess.CalledProcessError: + return 10 + # # Some data access functions. At the moment this uses git notes. # @@ -100,6 +108,15 @@ class MetricChange(Enum): } return strings[self] + def short_name(self): + strings = { + MetricChange.NewMetric: "new", + MetricChange.NoChange: "unch", + MetricChange.Increase: "incr", + MetricChange.Decrease: "decr" + } + return strings[self] + AllowedPerfChange = NamedTuple('AllowedPerfChange', [('direction', MetricChange), ('metrics', List[str]), @@ -758,7 +775,7 @@ def main() -> None: exit(0) # - # String utilities for pretty-printing + # Print the data in tablular format # # T1234 T1234 @@ -770,11 +787,12 @@ def main() -> None: # HEAD~1 10023 10023 # HEAD~2 21234 21234 # HEAD~3 20000 20000 - - # Data is already in colum major format, so do that, calculate column widths - # then transpose and print each row. def strMetric(x): return '{:.2f}'.format(x.value) if x != None else "" + # Data is in colum major format, so transpose and pass to print_table. + T = TypeVar('T') + def transpose(xss: List[List[T]]) -> List[List[T]]: + return list(map(list, zip(*xss))) headerCols = [ ["","","","Commit"] ] \ + [ [name, metric, way, env] for (env, name, metric, way) in testSeries ] @@ -782,17 +800,7 @@ def main() -> None: + [ [strMetric(get_commit_metric(ref, commit, env, name, metric, way)) \ for commit in commits ] \ for (env, name, metric, way) in testSeries ] - colWidths = [max([2+len(cell) for cell in colH + colD]) for (colH,colD) in zip(headerCols, dataCols)] - col_fmts = ['{:>' + str(w) + '}' for w in colWidths] - - def printCols(cols): - for row in zip(*cols): - # print(list(zip(col_fmts, row))) - print(''.join([f.format(cell) for (f,cell) in zip(col_fmts, row)])) - - printCols(headerCols) - print('-'*(sum(colWidths)+2)) - printCols(dataCols) + print_table(transpose(headerCols), transpose(dataCols)) if __name__ == '__main__': main() ===================================== testsuite/driver/runtests.py ===================================== @@ -23,11 +23,11 @@ import traceback # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import getStdout, Watcher, str_warn, str_info +from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \ TestOptions, brokens, PerfMetric from my_typing import TestName -from perf_notes import MetricChange, GitRef, inside_git_repo, is_worktree_dirty, format_perf_stat +from perf_notes import MetricChange, GitRef, inside_git_repo, is_worktree_dirty, format_perf_stat, get_abbrev_hash_length, is_commit_hash from junit import junit import term_color from term_color import Color, colored @@ -341,23 +341,52 @@ def cleanup_and_exit(exitcode): exit(exitcode) def tabulate_metrics(metrics: List[PerfMetric]) -> None: - for metric in sorted(metrics, key=lambda m: (m.stat.test, m.stat.way, m.stat.metric)): - print("{test:24} {metric:40} {value:15.3f}".format( - test = "{}({})".format(metric.stat.test, metric.stat.way), - metric = metric.stat.metric, - value = metric.stat.value - )) - if metric.baseline is not None: - val0 = metric.baseline.perfStat.value - val1 = metric.stat.value - rel = 100 * (val1 - val0) / val0 - print("{space:24} {herald:40} {value:15.3f} [{direction}, {rel:2.1f}%]".format( - space = "", - herald = "(baseline @ {commit})".format( - commit = metric.baseline.commit), - value = val0, - direction = metric.change, - rel = rel + abbrevLen = get_abbrev_hash_length() + hasBaseline = any([x.baseline is not None for x in metrics]) + baselineCommitSet = set([x.baseline.commit for x in metrics if x.baseline is not None]) + hideBaselineCommit = not hasBaseline or len(baselineCommitSet) == 1 + hideBaselineEnv = not hasBaseline or all( + [x.stat.test_env == x.baseline.perfStat.test_env + for x in metrics if x.baseline is not None]) + def row(cells: Tuple[str, str, str, str, str, str, str]) -> List[str]: + return [x for (idx, x) in enumerate(list(cells)) if + (idx != 2 or not hideBaselineCommit) and + (idx != 3 or not hideBaselineEnv )] + + headerRows = [ + row(("", "", "Baseline", "Baseline", "Baseline", "", "")), + row(("Test", "Metric", "commit", "environment", "value", "New value", "Change")) + ] + def strDiff(x: PerfMetric) -> str: + if x.baseline is None: + return "" + val0 = x.baseline.perfStat.value + val1 = x.stat.value + return "{}({:+2.1f}%)".format(x.change.short_name(), 100 * (val1 - val0) / val0) + dataRows = [row(( + "{}({})".format(x.stat.test, x.stat.way), + shorten_metric_name(x.stat.metric), + "{}".format(x.baseline.commit[:abbrevLen] + if is_commit_hash(x.baseline.commit) else x.baseline.commit) + if x.baseline is not None else "", + "{}".format(x.baseline.perfStat.test_env) + if x.baseline is not None else "", + "{:13.1f}".format(x.baseline.perfStat.value) + if x.baseline is not None else "", + "{:13.1f}".format(x.stat.value), + strDiff(x) + )) for x in sorted(metrics, key = + lambda m: (m.stat.test, m.stat.way, m.stat.metric))] + print_table(headerRows, dataRows, 1) + print("") + if hasBaseline: + if hideBaselineEnv: + print("* All baselines were measured in the same environment as this test run") + if hideBaselineCommit: + commit = next(iter(baselineCommitSet)) + print("* All baseline commits are {}".format( + commit[:abbrevLen] + if is_commit_hash(commit) else commit )) # First collect all the tests to be run ===================================== testsuite/driver/testutil.py ===================================== @@ -144,3 +144,29 @@ def memoize(f): cached._cache = None return cached + +# Print the matrix data in a tabular format. +def print_table(header_rows: List[List[str]], data_rows: List[List[str]], padding=2) -> None: + # Calculate column widths then print each row. + colWidths = [(0 if idx == 0 else padding) + max([len(cell) for cell in col]) + for (idx, col) in enumerate(zip(*(header_rows + data_rows)))] + col_fmts = ['{:>' + str(w) + '}' for w in colWidths] + + def printCols(cols): + for row in cols: + print(''.join([f.format(cell) for (f,cell) in zip(col_fmts, row)])) + + printCols(header_rows) + print('-' * sum(colWidths)) + printCols(data_rows) + +def shorten_metric_name(name: str) -> str: + dic = { + "runtime/bytes allocated": "run/alloc", + "runtime/peak_megabytes_allocated": "run/peak", + "runtime/max_bytes_used": "run/max", + "compile_time/bytes allocated": "ghc/alloc", + "compile_time/peak_megabytes_allocated": "ghc/peak", + "compile_time/max_bytes_used": "ghc/max", + } + return dic.get(name, name) ===================================== testsuite/tests/dependent/should_compile/T18660.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T18660 where + +type F :: forall a -> b -> b +type F x y = y ===================================== testsuite/tests/dependent/should_compile/all.T ===================================== @@ -66,3 +66,4 @@ test('T16326_Compile2', normal, compile, ['']) test('T16391a', normal, compile, ['']) test('T16344b', normal, compile, ['']) test('T16347', normal, compile, ['']) +test('T18660', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae81705781fe1646f1c1f862b37cf1905397e8b3...dd5196ea57a5cdfa80ff943c298e05002f9ca621 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ae81705781fe1646f1c1f862b37cf1905397e8b3...dd5196ea57a5cdfa80ff943c298e05002f9ca621 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 15:37:21 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Tue, 08 Sep 2020 11:37:21 -0400 Subject: [Git][ghc/ghc][wip/int64-everywhere] WIP: Add missing floats <-> int/word 64 rule and primops Message-ID: <5f57a531c4fd4_80b3f83f3b339e811079933@gitlab.haskell.org.mail> John Ericson pushed to branch wip/int64-everywhere at Glasgow Haskell Compiler / GHC Commits: e57c5969 by John Ericson at 2020-09-08T10:59:00-04:00 WIP: Add missing floats <-> int/word 64 rule and primops - - - - - 16 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/CPrim.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Types/Literal.hs - includes/stg/Prim.h - libraries/base/GHC/Float.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Word.hs - libraries/ghc-prim/cbits/word2float.c Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -774,11 +774,15 @@ primop ChrOp "chr#" GenPrimOp Int# -> Char# primop IntToWordOp "int2Word#" GenPrimOp Int# -> Word# with code_size = 0 -primop IntToFloatOp "int2Float#" GenPrimOp Int# -> Float# -primop IntToDoubleOp "int2Double#" GenPrimOp Int# -> Double# +primop IntToFloatOp "int2Float#" GenPrimOp Int# -> Float# +primop IntToDoubleOp "int2Double#" GenPrimOp Int# -> Double# +primop Int64ToFloatOp "int64ToFloat#" GenPrimOp Int64# -> Float# +primop Int64ToDoubleOp "int64ToDouble#" GenPrimOp Int64# -> Double# -primop WordToFloatOp "word2Float#" GenPrimOp Word# -> Float# -primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double# +primop WordToFloatOp "word2Float#" GenPrimOp Word# -> Float# +primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double# +primop Word64ToFloatOp "word64ToFloat#" GenPrimOp Word64# -> Float# +primop Word64ToDoubleOp "word64ToDouble#" GenPrimOp Word64# -> Double# primop IntSllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int# {Shift left. Result undefined if shift amount is not @@ -1016,6 +1020,7 @@ primop DoubleToIntOp "double2Int#" GenPrimOp Double# -> Int# {Truncates a {\tt Double#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} +primop DoubleToInt64Op "doubleToInt64#" GenPrimOp Double# -> Int64# primop DoubleToFloatOp "double2Float#" GenPrimOp Double# -> Float# @@ -1170,6 +1175,7 @@ primop FloatToIntOp "float2Int#" GenPrimOp Float# -> Int# {Truncates a {\tt Float#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} +primop FloatToInt64Op "floatToInt64#" GenPrimOp Float# -> Int64# primop FloatExpOp "expFloat#" GenPrimOp Float# -> Float# ===================================== compiler/GHC/Cmm/MachOp.hs ===================================== @@ -122,6 +122,7 @@ data MachOp -- is equivalent to just x. | MO_FF_Conv Width Width -- Float -> Float + -- Vector element insertion and extraction operations | MO_V_Insert Length Width -- Insert scalar into vector | MO_V_Extract Length Width -- Extract scalar from vector @@ -586,7 +587,7 @@ data CallishMachOp | MO_F32_Fabs | MO_F32_Sqrt - | MO_UF_Conv Width + | MO_UF_Conv Width Width -- unsigned int -> Float | MO_S_Mul2 Width | MO_S_QuotRem Width ===================================== compiler/GHC/CmmToAsm/CPrim.hs ===================================== @@ -84,8 +84,8 @@ ctzLabel w = "hs_ctz" ++ pprWidth w pprWidth W64 = "64" pprWidth w = pprPanic "ctzLabel: Unsupported word width " (ppr w) -word2FloatLabel :: Width -> String -word2FloatLabel w = "hs_word2float" ++ pprWidth w +word2FloatLabel :: Width -> Width -> String +word2FloatLabel wFrom wTo = "hs_word" ++ pprWidth wFrom ++ "_to_float" ++ pprWidth wTo where pprWidth W32 = "32" pprWidth W64 = "64" ===================================== compiler/GHC/CmmToAsm/PPC/CodeGen.hs ===================================== @@ -2009,7 +2009,7 @@ genCCall' config gcp target dest_regs args MO_F64_Acosh -> (fsLit "acosh", False) MO_F64_Atanh -> (fsLit "atanh", False) - MO_UF_Conv w -> (fsLit $ word2FloatLabel w, False) + MO_UF_Conv wFrom wTo -> (fsLit $ word2FloatLabel wFrom wTo, False) MO_Memcpy _ -> (fsLit "memcpy", False) MO_Memset _ -> (fsLit "memset", False) ===================================== compiler/GHC/CmmToAsm/SPARC/CodeGen.hs ===================================== @@ -661,7 +661,7 @@ outOfLineMachOp_table mop MO_F64_Acosh -> fsLit "acosh" MO_F64_Atanh -> fsLit "atanh" - MO_UF_Conv w -> fsLit $ word2FloatLabel w + MO_UF_Conv wFrom wTo -> fsLit $ word2FloatLabel wFrom wTo MO_Memcpy _ -> fsLit "memcpy" MO_Memset _ -> fsLit "memset" ===================================== compiler/GHC/CmmToAsm/X86/CodeGen.hs ===================================== @@ -2507,7 +2507,7 @@ genCCall' config is32Bit (PrimTarget (MO_Clz width)) dest_regs@[dst] args@[src] bw = widthInBits width lbl = mkCmmCodeLabel primUnitId (fsLit (clzLabel width)) -genCCall' config is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do +genCCall' config is32Bit (PrimTarget (MO_UF_Conv wFrom wTo)) dest_regs args bid = do targetExpr <- cmmMakeDynamicReference config CallReference lbl let target = ForeignTarget targetExpr (ForeignConvention CCallConv @@ -2515,7 +2515,7 @@ genCCall' config is32Bit (PrimTarget (MO_UF_Conv width)) dest_regs args bid = do CmmMayReturn) genCCall' config is32Bit target dest_regs args bid where - lbl = mkCmmCodeLabel primUnitId (fsLit (word2FloatLabel width)) + lbl = mkCmmCodeLabel primUnitId $ fsLit $ word2FloatLabel wFrom wTo genCCall' _ _ (PrimTarget (MO_AtomicRead width)) [dst] [addr] _ = do load_code <- intLoadCode (MOV (intFormat width)) addr @@ -3341,7 +3341,7 @@ outOfLineCmmOp bid mop res args MO_Cmpxchg _ -> fsLit "cmpxchg" MO_Xchg _ -> should_be_inline - MO_UF_Conv _ -> unsupported + MO_UF_Conv _ _ -> unsupported MO_S_Mul2 {} -> unsupported MO_S_QuotRem {} -> unsupported ===================================== compiler/GHC/CmmToC.hs ===================================== @@ -821,7 +821,7 @@ pprCallishMachOp_for_C mop (MO_Xchg w) -> ptext (sLit $ xchgLabel w) (MO_AtomicRead w) -> ptext (sLit $ atomicReadLabel w) (MO_AtomicWrite w) -> ptext (sLit $ atomicWriteLabel w) - (MO_UF_Conv w) -> ptext (sLit $ word2FloatLabel w) + (MO_UF_Conv wFrom wTo) -> ptext (sLit $ word2FloatLabel wFrom wTo) MO_S_Mul2 {} -> unsupported MO_S_QuotRem {} -> unsupported ===================================== compiler/GHC/CmmToLlvm/CodeGen.hs ===================================== @@ -201,7 +201,7 @@ genCall (PrimTarget MO_WriteBarrier) _ _ = do genCall (PrimTarget MO_Touch) _ _ = return (nilOL, []) -genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do +genCall (PrimTarget (MO_UF_Conv _ w)) [dst] [e] = runStmtsDecls $ do dstV <- getCmmRegW (CmmLocal dst) let ty = cmmToLlvmType $ localRegType dst width = widthToLlvmFloat w @@ -210,7 +210,7 @@ genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do statement $ Assignment castV $ Cast LM_Uitofp ve width statement $ Store castV dstV -genCall (PrimTarget (MO_UF_Conv _)) [_] args = +genCall (PrimTarget (MO_UF_Conv _ _)) [_] args = panic $ "genCall: Too many arguments to MO_UF_Conv. " ++ "Can only handle 1, given" ++ show (length args) ++ "." @@ -897,7 +897,7 @@ cmmPrimOpFunctions mop = do MO_ReadBarrier -> unsupported MO_WriteBarrier -> unsupported MO_Touch -> unsupported - MO_UF_Conv _ -> unsupported + MO_UF_Conv _ _ -> unsupported MO_AtomicRead _ -> unsupported MO_AtomicRMW _ _ -> unsupported ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -315,6 +315,10 @@ primOpRules nm = \case IntToFloatOp -> mkPrimOpRule nm 1 [ liftLit intToFloatLit ] DoubleToIntOp -> mkPrimOpRule nm 1 [ liftLit doubleToIntLit ] IntToDoubleOp -> mkPrimOpRule nm 1 [ liftLit intToDoubleLit ] + FloatToInt64Op -> mkPrimOpRule nm 1 [ liftLit floatToInt64Lit ] + Int64ToFloatOp -> mkPrimOpRule nm 1 [ liftLit int64ToFloatLit ] + DoubleToInt64Op -> mkPrimOpRule nm 1 [ liftLit doubleToInt64Lit ] + Int64ToDoubleOp -> mkPrimOpRule nm 1 [ liftLit int64ToDoubleLit ] -- SUP: Not sure what the standard says about precision in the following 2 cases FloatToDoubleOp -> mkPrimOpRule nm 1 [ liftLit floatToDoubleLit ] DoubleToFloatOp -> mkPrimOpRule nm 1 [ liftLit doubleToFloatLit ] ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -841,9 +841,14 @@ emitPrimOp dflags primop = case primop of -- Unsigned int to floating point conversions WordToFloatOp -> \[w] -> opIntoRegs $ \[res] -> do - emitPrimCall [res] (MO_UF_Conv W32) [w] + emitPrimCall [res] (MO_UF_Conv (wordWidth platform) W32) [w] + Word64ToFloatOp -> \[w] -> opIntoRegs $ \[res] -> do + emitPrimCall [res] (MO_UF_Conv W64 W32) [w] + WordToDoubleOp -> \[w] -> opIntoRegs $ \[res] -> do - emitPrimCall [res] (MO_UF_Conv W64) [w] + emitPrimCall [res] (MO_UF_Conv (wordWidth platform) W64) [w] + Word64ToDoubleOp -> \[w] -> opIntoRegs $ \[res] -> do + emitPrimCall [res] (MO_UF_Conv W64 W64) [w] -- Atomic operations InterlockedExchange_Addr -> \[src, value] -> opIntoRegs $ \[res] -> @@ -1408,9 +1413,15 @@ emitPrimOp dflags primop = case primop of IntToDoubleOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W64) DoubleToIntOp -> \args -> opTranslate args (MO_FS_Conv W64 (wordWidth platform)) + Int64ToDoubleOp -> \args -> opTranslate args (MO_SF_Conv W64 W64) + DoubleToInt64Op -> \args -> opTranslate args (MO_FS_Conv W64 W64) + IntToFloatOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W32) FloatToIntOp -> \args -> opTranslate args (MO_FS_Conv W32 (wordWidth platform)) + Int64ToFloatOp -> \args -> opTranslate args (MO_SF_Conv W64 W32) + FloatToInt64Op -> \args -> opTranslate args (MO_FS_Conv W32 W64) + FloatToDoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64) DoubleToFloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32) ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -45,8 +45,12 @@ module GHC.Types.Literal , narrow8IntLit, narrow16IntLit, narrow32IntLit , narrow8WordLit, narrow16WordLit, narrow32WordLit , charToIntLit, intToCharLit - , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit - , nullAddrLit, rubbishLit, floatToDoubleLit, doubleToFloatLit + , floatToIntLit, intToFloatLit + , floatToInt64Lit, int64ToFloatLit + , doubleToIntLit, intToDoubleLit + , doubleToInt64Lit, int64ToDoubleLit + , floatToDoubleLit, doubleToFloatLit + , nullAddrLit, rubbishLit ) where #include "HsVersions.h" @@ -487,7 +491,10 @@ isLitValue = isJust . isLitValue_maybe narrow8IntLit, narrow16IntLit, narrow32IntLit, narrow8WordLit, narrow16WordLit, narrow32WordLit, charToIntLit, intToCharLit, - floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit, + floatToIntLit, intToFloatLit, + floatToInt64Lit, int64ToFloatLit, + doubleToIntLit, intToDoubleLit, + doubleToInt64Lit, int64ToDoubleLit, floatToDoubleLit, doubleToFloatLit :: Literal -> Literal @@ -553,11 +560,21 @@ floatToIntLit l = pprPanic "floatToIntLit" (ppr l) intToFloatLit (LitNumber _ i) = LitFloat (fromInteger i) intToFloatLit l = pprPanic "intToFloatLit" (ppr l) +floatToInt64Lit (LitFloat f) = mkLitInt64Unchecked (truncate f) +floatToInt64Lit l = pprPanic "floatToInt64Lit" (ppr l) +int64ToFloatLit (LitNumber _ i) = LitFloat (fromInteger i) +int64ToFloatLit l = pprPanic "int64ToFloatLit" (ppr l) + doubleToIntLit (LitDouble f) = mkLitIntUnchecked (truncate f) doubleToIntLit l = pprPanic "doubleToIntLit" (ppr l) intToDoubleLit (LitNumber _ i) = LitDouble (fromInteger i) intToDoubleLit l = pprPanic "intToDoubleLit" (ppr l) +doubleToInt64Lit (LitDouble f) = mkLitInt64Unchecked (truncate f) +doubleToInt64Lit l = pprPanic "doubleToInt64Lit" (ppr l) +int64ToDoubleLit (LitNumber _ i) = LitDouble (fromInteger i) +int64ToDoubleLit l = pprPanic "int64ToDoubleLit" (ppr l) + floatToDoubleLit (LitFloat f) = LitDouble f floatToDoubleLit l = pprPanic "floatToDoubleLit" (ppr l) doubleToFloatLit (LitDouble d) = LitFloat d ===================================== includes/stg/Prim.h ===================================== @@ -88,8 +88,10 @@ StgWord hs_popcnt64(StgWord64 x); StgWord hs_popcnt(StgWord x); /* libraries/ghc-prim/cbits/word2float.c */ -StgFloat hs_word2float32(StgWord x); -StgDouble hs_word2float64(StgWord x); +StgFloat hs_word32_to_float32(StgWord32 x); +StgDouble hs_word32_to_float64(StgWord32 x); +StgFloat hs_word64_to_float32(StgWord64 x); +StgDouble hs_word64_to_float64(StgWord64 x); /* libraries/ghc-prim/cbits/clz.c */ StgWord hs_clz8(StgWord x); ===================================== libraries/base/GHC/Float.hs ===================================== @@ -1296,8 +1296,11 @@ word2Float (W# w) = F# (word2Float# w) "realToFrac/Float->Double" realToFrac = float2Double "realToFrac/Double->Float" realToFrac = double2Float "realToFrac/Double->Double" realToFrac = id :: Double -> Double -"realToFrac/Int->Double" realToFrac = int2Double -- See Note [realToFrac int-to-float] -"realToFrac/Int->Float" realToFrac = int2Float -- ..ditto +-- See Note [realToFrac int-to-float] on the below +"realToFrac/Int->Double" realToFrac = int2Double +"realToFrac/Int->Float" realToFrac = int2Float +"realToFrac/Word->Double" realToFrac = word2Double +"realToFrac/Word->Float" realToFrac = word2Float #-} {- ===================================== libraries/base/GHC/Int.hs ===================================== @@ -33,7 +33,10 @@ module GHC.Int ( eqInt8, neInt8, gtInt8, geInt8, ltInt8, leInt8, eqInt16, neInt16, gtInt16, geInt16, ltInt16, leInt16, eqInt32, neInt32, gtInt32, geInt32, ltInt32, leInt32, - eqInt64, neInt64, gtInt64, geInt64, ltInt64, leInt64 + eqInt64, neInt64, gtInt64, geInt64, ltInt64, leInt64, + -- * Floating point converions + doubleToInt64, int64ToDouble, + floatToInt64, int64ToFloat ) where import Data.Bits @@ -992,6 +995,18 @@ a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# else intToInt64# 0# | otherwise = a `uncheckedIShiftRA64#` b +doubleToInt64 :: Double -> Int64 +doubleToInt64 (D# x) = I64# (doubleToInt64# x) + +int64ToDouble :: Int64 -> Double +int64ToDouble (I64# i) = D# (int64ToDouble# i) + +floatToInt64 :: Float -> Int64 +floatToInt64 (F# x) = I64# (floatToInt64# x) + +int64ToFloat :: Int64 -> Float +int64ToFloat (I64# i) = F# (int64ToFloat# i) + {-# RULES "fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#) "fromIntegral/Word->Int64" fromIntegral = \(W# x#) -> I64# (word64ToInt64# (wordToWord64# x#)) @@ -1000,6 +1015,11 @@ a `iShiftRA64#` b | isTrue# (b >=# 64#) = if isTrue# (a `ltInt64#` (intToInt64# "fromIntegral/Int64->Word" fromIntegral = \(I64# x#) -> W# (int2Word# (int64ToInt# x#)) "fromIntegral/Int64->Word64" fromIntegral = \(I64# x#) -> W64# (int64ToWord64# x#) "fromIntegral/Int64->Int64" fromIntegral = id :: Int64 -> Int64 +-- See Note [realToFrac int-to-float] about below +"fromIntegral/Int64->Float" fromIntegral = int64ToFloat +"fromIntegral/Int64->Double" fromIntegral = int64ToDouble +"realToFrac/Int64->Double" realToFrac = int64ToDouble +"realToFrac/Int64->Float" realToFrac = int64ToFloat #-} -- No RULES for RealFrac methods if Int is smaller than Int64, we can't ===================================== libraries/base/GHC/Word.hs ===================================== @@ -43,7 +43,11 @@ module GHC.Word ( eqWord8, neWord8, gtWord8, geWord8, ltWord8, leWord8, eqWord16, neWord16, gtWord16, geWord16, ltWord16, leWord16, eqWord32, neWord32, gtWord32, geWord32, ltWord32, leWord32, - eqWord64, neWord64, gtWord64, geWord64, ltWord64, leWord64 + eqWord64, neWord64, gtWord64, geWord64, ltWord64, leWord64, + + -- * Floating point converions + word64ToDouble, + word64ToFloat ) where import Data.Bits @@ -940,12 +944,23 @@ a `shiftL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0## a `shiftRL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0## | otherwise = a `uncheckedShiftRL64#` b +word64ToDouble :: Word64 -> Double +word64ToDouble (W64# w) = D# (word64ToDouble# w) + +word64ToFloat :: Word64 -> Float +word64ToFloat (W64# w) = F# (word64ToFloat# w) + {-# RULES "fromIntegral/Int->Word64" fromIntegral = \(I# x#) -> W64# (int64ToWord64# (intToInt64# x#)) "fromIntegral/Word->Word64" fromIntegral = \(W# x#) -> W64# (wordToWord64# x#) "fromIntegral/Word64->Int" fromIntegral = \(W64# x#) -> I# (word2Int# (word64ToWord# x#)) "fromIntegral/Word64->Word" fromIntegral = \(W64# x#) -> W# (word64ToWord# x#) "fromIntegral/Word64->Word64" fromIntegral = id :: Word64 -> Word64 +-- See Note [realToFrac int-to-float] about below +"fromIntegral/Word64->Float" fromIntegral = word64ToFloat +"fromIntegral/Word64->Double" fromIntegral = word64ToDouble +"realToFrac/Word64->Double" realToFrac = word64ToDouble +"realToFrac/Word64->Float" realToFrac = word64ToFloat #-} #if WORD_SIZE_IN_BITS == 64 ===================================== libraries/ghc-prim/cbits/word2float.c ===================================== @@ -1,15 +1,29 @@ #include "Rts.h" -extern StgFloat hs_word2float32(StgWord x); +extern StgFloat hs_word32_to_float32(StgWord32 x); StgFloat -hs_word2float32(StgWord x) +hs_word32_to_float32(StgWord32 x) { return x; } -extern StgDouble hs_word2float64(StgWord x); +extern StgDouble hs_word32_to_float64(StgWord32 x); StgDouble -hs_word2float64(StgWord x) +hs_word32_to_float64(StgWord32 x) +{ + return x; +} + +extern StgFloat hs_word64_to_float32(StgWord64 x); +StgFloat +hs_word64_to_float32(StgWord64 x) +{ + return x; +} + +extern StgDouble hs_word64_to_float64(StgWord64 x); +StgDouble +hs_word64_to_float64(StgWord64 x) { return x; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e57c5969a0e4b3ad65fe029a23a742928449fd16 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e57c5969a0e4b3ad65fe029a23a742928449fd16 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 15:46:05 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Sep 2020 11:46:05 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] 59 commits: SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' Message-ID: <5f57a73d50141_80b3f83f3b339e811080371@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - 5dc55e80 by Ben Gamari at 2020-09-07T12:27:56-04:00 Introduce noDiv - - - - - 3848f531 by Ben Gamari at 2020-09-07T12:27:56-04:00 Simplify: Allow pushing of strict contexts into noDiv - - - - - 83736f5b by Ben Gamari at 2020-09-07T12:28:47-04:00 Magic: Add keepAlive# - - - - - 8717e570 by Ben Gamari at 2020-09-08T11:45:58-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - .gitlab/linters/check-cpp.py - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/PrimOps.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/PPC/Ppr.hs - compiler/GHC/CmmToAsm/Ppr.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/SPARC/Ppr.hs - compiler/GHC/CmmToAsm/X86/Ppr.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45133301bb78e2eaaf5766f9c2f7c35068c3d0df...8717e57060fe861e96fa74d96eba3f78a38d3ef9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/45133301bb78e2eaaf5766f9c2f7c35068c3d0df...8717e57060fe861e96fa74d96eba3f78a38d3ef9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 15:46:51 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Sep 2020 11:46:51 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump Win32 submodule to 2.9.0.0 Message-ID: <5f57a76b174f4_80b3f84925a950011081991@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 3e9f64ee by Ben Gamari at 2020-09-08T11:46:46-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 4 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - libraries/Cabal - libraries/directory Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -77,7 +77,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else if flag(terminfo) Build-Depends: terminfo == 0.4.* ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -45,7 +45,7 @@ Executable ghc ghc == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else Build-Depends: unix >= 2.7 && < 2.9 @@ -102,4 +102,4 @@ Executable ghc Default-Extensions: NoImplicitPrelude , ScopedTypeVariables - , BangPatterns \ No newline at end of file + , BangPatterns ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 32dad5c1cf70d65ecb93b0ec214445cf9c9f6615 +Subproject commit 6ff1851640c02bfd9cd4e8cbb62d2c9b3621afe9 ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3d9ca6edc0703860829ab3210db78bb4c4ff72b9 +Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e9f64eee51f99654fc028f470970f31f25d8742 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3e9f64eee51f99654fc028f470970f31f25d8742 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 15:49:37 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Sep 2020 11:49:37 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump Win32 submodule to 2.9.0.0 Message-ID: <5f57a81127e68_80b3f849ca3855811082390@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: d3aa798d by Ben Gamari at 2020-09-08T11:49:11-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 4 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - libraries/Cabal - libraries/directory Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -77,7 +77,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else if flag(terminfo) Build-Depends: terminfo == 0.4.* ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -45,7 +45,7 @@ Executable ghc ghc == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else Build-Depends: unix >= 2.7 && < 2.9 @@ -102,4 +102,4 @@ Executable ghc Default-Extensions: NoImplicitPrelude , ScopedTypeVariables - , BangPatterns \ No newline at end of file + , BangPatterns ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 32dad5c1cf70d65ecb93b0ec214445cf9c9f6615 +Subproject commit 2d8a1b60ae409291585b647be8f02bc42b23cbbb ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3d9ca6edc0703860829ab3210db78bb4c4ff72b9 +Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3aa798d07ef7d7ea229b4d830589e81836de182 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3aa798d07ef7d7ea229b4d830589e81836de182 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 16:25:46 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Tue, 08 Sep 2020 12:25:46 -0400 Subject: [Git][ghc/ghc][wip/T18599] Switch to do notation; restablish getBit check Message-ID: <5f57b08a45ac8_80b3f848d8f2c5c11084192@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: 56062acf by Shayne Fletcher at 2020-09-08T12:25:10-04:00 Switch to do notation; restablish getBit check - - - - - 2 changed files: - compiler/GHC/Parser.y - record-dot-syntax-tests/Test.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -2717,13 +2717,13 @@ aexp :: { ECP } | aexp1 { $1 } aexp1 :: { ECP } - : aexp1 '{' fbinds '}' {% getBit RecordDotSyntaxBit >>= \ dot -> - return (ECP $ - unECP $1 >>= \ $1 -> - $3 >>= \ $3 -> - amms (mkHsRecordPV dot (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3)) - (moc $2:mcc $4:(fst $3)) - ) } + : aexp1 '{' fbinds '}' { ECP $ + getBit RecordDotSyntaxBit >>= \ dot -> + unECP $1 >>= \ $1 -> + $3 >>= \ $3 -> + amms (mkHsRecordPV dot (comb2 $1 $>) (comb2 $2 $4) $1 (snd $3)) + (moc $2:mcc $4:(fst $3)) + } | aexp2 { $1 } aexp2 :: { ECP } @@ -3254,18 +3254,25 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- See Note [Whitespace-sensitive operator parsing] in Lexer.x | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp - { unECP $5 >>= \ $5 -> - fmap Pbind $ mkHsFieldUpdaterPV ($1 : reverse $3) $5 + {do + $5 <- unECP $5 + fmap Pbind $ mkHsFieldUpdaterPV ($1 : reverse $3) $5 } -- See Note [Whitespace-sensitive operator parsing] in Lexer.x | field TIGHT_INFIX_PROJ fieldToUpdate - { let { ; top = $1 - ; fields = top : reverse $3 - ; final = last fields } in - mkHsVarPV (noLoc (mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final)) >>= \ var -> - fmap Pbind (mkHsFieldUpdaterPV fields var) - } + {do + let top = $1 + fields = top : reverse $3 + final = last fields + (l, fieldName) = (getLoc final, unLoc final) + puns <- getBit RecordPunsBit + when (not puns) $ + addError (comb2 top final) $ + text "For this to work, enable NamedFieldPuns." + var <- mkHsVarPV (L l (mkRdrUnqual . mkVarOcc . unpackFS $ fieldName)) + fmap Pbind $ mkHsFieldUpdaterPV fields var + } fieldToUpdate :: { [Located FastString] } fieldToUpdate ===================================== record-dot-syntax-tests/Test.hs ===================================== @@ -112,4 +112,4 @@ main = do g <- pure a print $ c{f} -- 42, 1 print $ c{f, g} -- 42, 42 - print $ c{f, g.foo.bar.baz.quux = 4} -- Can now mix top-level and nested updates! + print $ c{f, g.foo.bar.baz.quux = 4} -- Can now mix top-level and nested updates!; 42, 4 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56062acfffa78cb9dc78e052a62b360c1dff5d82 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/56062acfffa78cb9dc78e052a62b360c1dff5d82 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 16:29:38 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 08 Sep 2020 12:29:38 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] 13 commits: [aarch64] Fix spill/reload Message-ID: <5f57b172cd986_80b3f845801cbe41108439b@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: 342e6e9a by Moritz Angermann at 2020-08-26T06:50:19+00:00 [aarch64] Fix spill/reload - - - - - 29bfd65e by Moritz Angermann at 2020-09-07T04:35:02+00:00 Try to get PIC right. - - - - - cbd07d60 by Moritz Angermann at 2020-09-07T04:36:28+00:00 Spill/Reload only need a smaller window - - - - - 499350e0 by Moritz Angermann at 2020-09-07T04:37:32+00:00 Drop bad/useless optimisation This was due to not handling PIC symbols correctly and injecting CmmLoad as we do on other platforms, but this doesn't translate to aarch64's got lookups. - - - - - 8a91cda3 by Moritz Angermann at 2020-09-07T04:37:53+00:00 B is b - - - - - f5f17010 by Moritz Angermann at 2020-09-07T04:39:01+00:00 Fix CCall |Now mark used registers properly for the Register Allocator. - - - - - 54bf82b5 by Moritz Angermann at 2020-09-07T16:13:59+00:00 :sob: - - - - - 7aebacf9 by Moritz Angermann at 2020-09-07T16:14:29+00:00 :sob: :sob: - - - - - 4cc23070 by Moritz Angermann at 2020-09-08T07:36:55+00:00 :sob: Segfault no 3. This showed up in T4114 - - - - - 873aff9f by Moritz Angermann at 2020-09-08T15:20:01+00:00 Add mkComment to `Instruction` - - - - - a2e7c94b by Moritz Angermann at 2020-09-08T15:22:23+00:00 Use mkComment for debugging - - - - - 0e4a574b by Moritz Angermann at 2020-09-08T15:26:32+00:00 Fix T4114 crashes T4114 causes this codepath to show up. - - - - - d088f7d1 by Moritz Angermann at 2020-09-08T15:27:13+00:00 Cleanup some compiler warnings - - - - - 12 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/Instr.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/PPC/Instr.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs - compiler/GHC/CmmToAsm/Reg/Linear/State.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs - compiler/GHC/CmmToAsm/SPARC/Instr.hs - compiler/GHC/CmmToAsm/X86/Instr.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -104,8 +104,8 @@ cmmTopCodeGen -> NatM [NatCmmDecl RawCmmStatics Instr] -- Thus we'll have to deal with either CmmProc ... -cmmTopCodeGen cmm@(CmmProc info lab live graph) = do - config <- getConfig +cmmTopCodeGen _cmm@(CmmProc info lab live graph) = do + -- config <- getConfig -- do -- traceM $ "-- -------------------------- cmmTopGen (CmmProc) -------------------------- --\n" -- ++ showSDocUnsafe (ppr cmm) @@ -120,15 +120,12 @@ cmmTopCodeGen cmm@(CmmProc info lab live graph) = do os = platformOS platform case picBaseMb of - Just picBase -> do - -- XXX: PIC not yet implemented - panic "AArch64.cmmTopCodeGen: PIC not implemented" - return tops + Just _picBase -> panic "AArch64.cmmTopCodeGen: picBase not implemented" Nothing -> return tops -- ... or CmmData. Do we want to align this? -cmmTopCodeGen cmm@(CmmData sec dat) = do - config <- getConfig +cmmTopCodeGen _cmm@(CmmData sec dat) = do + -- config <- getConfig -- do -- traceM $ "-- -------------------------- cmmTopGen (CmmData) -------------------------- --\n" -- ++ showSDocUnsafe (ppr cmm) @@ -141,7 +138,7 @@ basicBlockCodeGen , [NatCmmDecl RawCmmStatics Instr]) basicBlockCodeGen block = do - config <- getConfig + -- config <- getConfig -- do -- traceM $ "-- --------------------------- basicBlockCodeGen --------------------------- --\n" -- ++ showSDocUnsafe (ppr block) @@ -385,7 +382,7 @@ getFloatReg expr = do Any II64 code -> do tmp <- getNewRegNat FF64 return (tmp, FF64, code tmp) - Any w _code -> pprPanic "can't do getFloatReg on" (ppr expr) + Any _w _code -> pprPanic "can't do getFloatReg on" (ppr expr) -- can't do much for fixed. Fixed rep reg code -> return (reg, rep, code) @@ -481,7 +478,7 @@ getRegister' config plat expr , MOVK (OpReg W64 dst) (OpImmShift (ImmInt half2) SLSL 32) , MOVK (OpReg W64 dst) (OpImmShift (ImmInt half3) SLSL 48) ])) - CmmInt i rep -> do + CmmInt _i rep -> do (op, imm_code) <- litToImm' lit return (Any (intFormat rep) (\dst -> imm_code `snocOL` ANN (text $ show expr) (MOV (OpReg rep dst) op))) @@ -490,8 +487,8 @@ getRegister' config plat expr (op, imm_code) <- litToImm' lit return (Any (floatFormat w) (\dst -> imm_code `snocOL` ANN (text $ show expr) (MOV (OpReg w dst) op))) - CmmFloat f W8 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for bytes" (ppr expr) - CmmFloat f W16 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for halfs" (ppr expr) + CmmFloat _f W8 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for bytes" (ppr expr) + CmmFloat _f W16 -> pprPanic "getRegister' (CmmLit:CmmFloat), no support for halfs" (ppr expr) CmmFloat f W32 -> do let word = castFloatToWord32 (fromRational f) :: Word32 half0 = fromIntegral (fromIntegral word :: Word16) @@ -516,19 +513,19 @@ getRegister' config plat expr , MOVK (OpReg W64 tmp) (OpImmShift (ImmInt half3) SLSL 48) , MOV (OpReg W64 dst) (OpReg W64 tmp) ])) - CmmFloat f w -> pprPanic "getRegister' (CmmLit:CmmFloat), unsupported float lit" (ppr expr) + CmmFloat _f _w -> pprPanic "getRegister' (CmmLit:CmmFloat), unsupported float lit" (ppr expr) CmmVec _ -> pprPanic "getRegister' (CmmLit:CmmVec): " (ppr expr) - CmmLabel lbl -> do + CmmLabel _lbl -> do (op, imm_code) <- litToImm' lit let rep = cmmLitType plat lit format = cmmTypeFormat rep return (Any format (\dst -> imm_code `snocOL` (ANN (text $ show expr) $ LDR format (OpReg (formatToWidth format) dst) op))) - CmmLabelOff lbl off | is12bit (fromIntegral off) -> do + CmmLabelOff _lbl off | is12bit (fromIntegral off) -> do (op, imm_code) <- litToImm' lit let rep = cmmLitType plat lit format = cmmTypeFormat rep - width = typeWidth rep + -- width = typeWidth rep return (Any format (\dst -> imm_code `snocOL` LDR format (OpReg (formatToWidth format) dst) op)) CmmLabelOff lbl off -> do @@ -586,13 +583,16 @@ getRegister' config plat expr MO_FF_Conv from to -> return $ Any (floatFormat to) (\dst -> code `snocOL` FCVT (OpReg to dst) (OpReg from reg)) -- Conversions - MO_XX_Conv from to -> swizzleRegisterRep (intFormat to) <$> getRegister e + MO_XX_Conv _from to -> swizzleRegisterRep (intFormat to) <$> getRegister e _ -> pprPanic "getRegister' (monadic CmmMachOp):" (ppr expr) where toImm W8 = (OpImm (ImmInt 7)) toImm W16 = (OpImm (ImmInt 15)) toImm W32 = (OpImm (ImmInt 31)) toImm W64 = (OpImm (ImmInt 63)) + toImm W128 = (OpImm (ImmInt 127)) + toImm W256 = (OpImm (ImmInt 255)) + toImm W512 = (OpImm (ImmInt 511)) -- Dyadic machops: -- -- The general idea is: @@ -604,8 +604,8 @@ getRegister' config plat expr -- fallthrough to alert us if things go wrong! -- OPTIMIZATION WARNING: Dyadic CmmMachOp destructuring -- 0. XXX This should not exist! Rewrite: Reg +- 0 -> Reg - CmmMachOp (MO_Add _) [expr'@(CmmReg (CmmGlobal r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' - CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' + CmmMachOp (MO_Add _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' + CmmMachOp (MO_Sub _) [expr'@(CmmReg (CmmGlobal _r)), CmmLit (CmmInt 0 _)] -> getRegister' config plat expr' -- 1. Compute Reg +/- n directly. -- For Add/Sub we can directly encode 12bits, or 12bits lsl #12. CmmMachOp (MO_Add w) [(CmmReg reg), CmmLit (CmmInt n _)] @@ -656,7 +656,7 @@ getRegister' config plat expr return $ Any format_x (\dst -> code_x `appOL` code_y `appOL` op (OpReg w dst) (OpReg w reg_x) (OpReg w reg_y)) withTempIntReg w op = OpReg w <$> getNewRegNat (intFormat w) >>= op - withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op + -- withTempFloatReg w op = OpReg w <$> getNewRegNat (floatFormat w) >>= op intOp w op = do -- compute x <- x @@ -782,7 +782,7 @@ getRegister' config plat expr -- XXX op -> pprPanic "getRegister' (unhandled dyadic CmmMachOp): " $ (pprMachOp op) <+> text "in" <+> (ppr expr) - CmmMachOp op xs + CmmMachOp _op _xs -> pprPanic "getRegister' (variadic CmmMachOp): " (ppr expr) where @@ -841,18 +841,18 @@ getAmode platform (CmmRegOff reg off) -- CmmStore (CmmMachOp (MO_Add w) [CmmLoad expr, CmmLit (CmmInt n w')]) (expr2) -- E.g. a CmmStoreOff really. This can be translated to `str $expr2, [$expr, #n ] -- for `n` in range. -getAmode platform (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')]) +getAmode _platform (CmmMachOp (MO_Add _w) [expr, CmmLit (CmmInt off _w')]) | -256 <= off, off <= 255 = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrRegImm reg (ImmInteger off)) code -getAmode platform (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')]) +getAmode _platform (CmmMachOp (MO_Sub _w) [expr, CmmLit (CmmInt off _w')]) | -256 <= -off, -off <= 255 = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrRegImm reg (ImmInteger (-off))) code -- Generic case -getAmode _plat expr +getAmode _platform expr = do (reg, _format, code) <- getSomeReg expr return $ Amode (AddrReg reg) code @@ -904,7 +904,7 @@ assignReg_FltCode = assignReg_IntCode -- ----------------------------------------------------------------------------- -- Jumps genJump :: CmmExpr{-the branch target-} -> [Reg] -> NatM InstrBlock -genJump expr@(CmmLit (CmmLabel lbl)) regs +genJump expr@(CmmLit (CmmLabel lbl)) _regs = return $ unitOL (ANN (text $ show expr) (J (TLabel lbl))) -- = return (toOL [ PUSH_STACK_FRAME -- , DELTA (-16) @@ -912,12 +912,7 @@ genJump expr@(CmmLit (CmmLabel lbl)) regs -- , POP_STACK_FRAME -- , DELTA 0] ) --- no reason to load label into register just to --- do a register jump. -genJump expr@(CmmLoad (CmmLit (CmmLabel lbl)) _rep) regs - = return $ unitOL (ANN (text $ show expr) (J (TLabel lbl))) - -genJump expr regs = do +genJump expr _regs = do (target, _format, code) <- getSomeReg expr return (code `appOL` unitOL (ANN (text $ show expr) (J (TReg target))) -- toOL [ PUSH_STACK_FRAME @@ -1107,9 +1102,10 @@ genCCall target dest_regs arg_regs bid = do -- this will give us the format information to match on. arg_regs' <- mapM getSomeReg arg_regs - (stackArgs, passArgumentsCode) <- passArguments allGpArgRegs allFpArgRegs arg_regs' 0 nilOL + (stackArgs, passRegs, passArgumentsCode) <- passArguments allGpArgRegs allFpArgRegs arg_regs' 0 [] nilOL + + (returnRegs, readResultsCode) <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL - readResultsCode <- readResults allGpArgRegs allFpArgRegs dest_regs nilOL let moveStackDown 0 = toOL [ PUSH_STACK_FRAME , DELTA (-16) ] moveStackDown i | odd i = moveStackDown (i + 1) @@ -1126,7 +1122,7 @@ genCCall target dest_regs arg_regs bid = do let code = call_target_code -- compute the label (possibly into a register) `appOL` moveStackDown stackArgs `appOL` passArgumentsCode -- put the arguments into x0, ... - `appOL` (unitOL $ BL call_target) -- branch and link. + `appOL` (unitOL $ BL call_target passRegs returnRegs) -- branch and link. `appOL` readResultsCode -- parse the results into registers `appOL` moveStackUp stackArgs return (code, Nothing) @@ -1253,8 +1249,8 @@ genCCall target dest_regs arg_regs bid = do genCCall (ForeignTarget target cconv) dest_regs arg_regs bid -- XXX: Optimize using paired load LDP - passArguments :: [Reg] -> [Reg] -> [(Reg, Format, InstrBlock)] -> Int -> InstrBlock -> NatM (Int, InstrBlock) - passArguments _ _ [] stackArgs accumCode = return (stackArgs, accumCode) + passArguments :: [Reg] -> [Reg] -> [(Reg, Format, InstrBlock)] -> Int -> [Reg] -> InstrBlock -> NatM (Int, [Reg], InstrBlock) + passArguments _ _ [] stackArgs accumRegs accumCode = return (stackArgs, accumRegs, accumCode) -- passArguments _ _ [] accumCode stackArgs | isEven stackArgs = return $ SUM (OpReg W64 x31) (OpReg W64 x31) OpImm (ImmInt (-8 * stackArgs)) -- passArguments _ _ [] accumCode stackArgs = return $ SUM (OpReg W64 x31) (OpReg W64 x31) OpImm (ImmInt (-8 * (stackArgs + 1))) -- passArguments [] fpRegs (arg0:arg1:args) stack accumCode = do @@ -1292,40 +1288,40 @@ genCCall target dest_regs arg_regs bid = do -- For AArch64 specificies see: https://developer.arm.com/docs/ihi0055/latest/procedure-call-standard-for-the-arm-64-bit-architecture -- -- Still have GP regs, and we want to pass an GP argument. - passArguments (gpReg:gpRegs) fpRegs ((r, format, code_r):args) stackArgs accumCode | isIntFormat format = do + passArguments (gpReg:gpRegs) fpRegs ((r, format, code_r):args) stackArgs accumRegs accumCode | isIntFormat format = do let w = formatToWidth format - passArguments gpRegs fpRegs args stackArgs (accumCode `appOL` code_r `snocOL` MOV (OpReg w gpReg) (OpReg w r)) + passArguments gpRegs fpRegs args stackArgs (gpReg:accumRegs) (accumCode `appOL` code_r `snocOL` (ANN (text $ "Pass gp argument: " ++ show r) $ MOV (OpReg w gpReg) (OpReg w r))) -- Still have FP regs, and we want to pass an FP argument. - passArguments gpRegs (fpReg:fpRegs) ((r, format, code_r):args) stackArgs accumCode | isFloatFormat format = do + passArguments gpRegs (fpReg:fpRegs) ((r, format, code_r):args) stackArgs accumRegs accumCode | isFloatFormat format = do let w = formatToWidth format - passArguments gpRegs fpRegs args stackArgs (accumCode `appOL` code_r `snocOL` MOV (OpReg w fpReg) (OpReg w r)) + passArguments gpRegs fpRegs args stackArgs (fpReg:accumRegs) (accumCode `appOL` code_r `snocOL` (ANN (text $ "Pass fp argument: " ++ show r) $ MOV (OpReg w fpReg) (OpReg w r))) -- No mor regs left to pass. Must pass on stack. - passArguments [] [] ((r, format, code_r):args) stackArgs accumCode = do + passArguments [] [] ((r, format, code_r):args) stackArgs accumRegs accumCode = do let w = formatToWidth format - stackCode = code_r `snocOL` STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt (stackArgs * 8)))) - passArguments [] [] args (stackArgs+1) (stackCode `appOL` accumCode) + stackCode = code_r `snocOL` (ANN (text $ "Pass argument: " ++ show r) $ STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt (stackArgs * 8))))) + passArguments [] [] args (stackArgs+1) accumRegs (stackCode `appOL` accumCode) -- Still have fpRegs left, but want to pass a GP argument. Must be passed on the stack then. - passArguments [] fpRegs ((r, format, code_r):args) stackArgs accumCode | isIntFormat format = do + passArguments [] fpRegs ((r, format, code_r):args) stackArgs accumRegs accumCode | isIntFormat format = do let w = formatToWidth format - stackCode = code_r `snocOL` STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt (stackArgs * 8)))) - passArguments [] fpRegs args (stackArgs+1) (stackCode `appOL` accumCode) + stackCode = code_r `snocOL` (ANN (text $ "Pass argument: " ++ show r) $ STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt (stackArgs * 8))))) + passArguments [] fpRegs args (stackArgs+1) accumRegs (stackCode `appOL` accumCode) -- Still have gpRegs left, but want to pass a FP argument. Must be passed on the stack then. - passArguments gpRegs [] ((r, format, code_r):args) stackArgs accumCode | isFloatFormat format = do + passArguments gpRegs [] ((r, format, code_r):args) stackArgs accumRegs accumCode | isFloatFormat format = do let w = formatToWidth format - stackCode = code_r `snocOL` STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt (stackArgs * 8)))) - passArguments gpRegs [] args (stackArgs+1) (stackCode `appOL` accumCode) + stackCode = code_r `snocOL` (ANN (text $ "Pass argument: " ++ show r) $ STR format (OpReg w r) (OpAddr (AddrRegImm (regSingle 31) (ImmInt (stackArgs * 8))))) + passArguments gpRegs [] args (stackArgs+1) accumRegs (stackCode `appOL` accumCode) - passArguments _ _ _ _ _ = pprPanic "passArguments" (text "invalid state") + passArguments _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state") - readResults :: [Reg] -> [Reg] -> [LocalReg] -> InstrBlock -> NatM InstrBlock - readResults _ _ [] accumCode = return accumCode - readResults [] _ _ _ = pprPanic "genCCall, out of gp registers when reading results" (ppr target) - readResults _ [] _ _ = pprPanic "genCCall, out of gp registers when reading results" (ppr target) - readResults (gpReg:gpRegs) (fpReg:fpRegs) (dst:dsts) accumCode = do + readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM ([Reg], InstrBlock) + readResults _ _ [] accumRegs accumCode = return (accumRegs, accumCode) + readResults [] _ _ _ _ = pprPanic "genCCall, out of gp registers when reading results" (ppr target) + readResults _ [] _ _ _ = pprPanic "genCCall, out of fp registers when reading results" (ppr target) + readResults (gpReg:gpRegs) (fpReg:fpRegs) (dst:dsts) accumRegs accumCode = do -- gp/fp reg -> dst platform <- getPlatform let rep = cmmRegType platform (CmmLocal dst) @@ -1333,8 +1329,8 @@ genCCall target dest_regs arg_regs bid = do w = cmmRegWidth platform (CmmLocal dst) r_dst = getRegisterReg platform (CmmLocal dst) if isFloatFormat format - then readResults (gpReg:gpRegs) fpRegs dsts (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg)) - else readResults gpRegs (fpReg:fpRegs) dsts (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg)) + then readResults (gpReg:gpRegs) fpRegs dsts (fpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w fpReg)) + else readResults gpRegs (fpReg:fpRegs) dsts (gpReg:accumRegs) (accumCode `snocOL` MOV (OpReg w r_dst) (OpReg w gpReg)) ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -35,6 +35,9 @@ import Control.Monad (replicateM) import Data.Maybe (fromMaybe) import Debug.Trace +import GHC.Stack + +import Data.Bits ((.&.), complement) -- | XXX: verify this! stackFrameHeaderSize :: Platform -> Int @@ -78,6 +81,7 @@ instance Instruction Instr where mkJumpInstr = aarch64_mkJumpInstr mkStackAllocInstr = aarch64_mkStackAllocInstr mkStackDeallocInstr = aarch64_mkStackDeallocInstr + mkComment = pure . COMMENT -- | Get the registers that are being used by this instruction. -- regUsage doesn't need to do any trickery for jumps and such. @@ -129,7 +133,7 @@ aarch64_regUsageOfInstr platform instr = case instr of J t -> usage (regTarget t, []) B t -> usage (regTarget t, []) BCOND _ t -> usage (regTarget t, []) - BL t -> usage (regTarget t, callerSavedRegisters) + BL t ps _rs -> usage (regTarget t ++ ps, callerSavedRegisters) -- 5. Atomic Instructions ---------------------------------------------------- -- 6. Conditional Instructions ----------------------------------------------- @@ -254,7 +258,7 @@ aarch64_patchRegsOfInstr instr env = case instr of -- 4. Branch Instructions -------------------------------------------------- J t -> J (patchTarget t) B t -> B (patchTarget t) - BL t -> BL (patchTarget t) + BL t rs ts -> BL (patchTarget t) rs ts BCOND c t -> BCOND c (patchTarget t) -- 5. Atomic Instructions -------------------------------------------------- @@ -314,7 +318,7 @@ aarch64_jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]] aarch64_jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]] aarch64_jumpDestsOfInstr (J t) = [id | TBlock id <- [t]] aarch64_jumpDestsOfInstr (B t) = [id | TBlock id <- [t]] -aarch64_jumpDestsOfInstr (BL t) = [ id | TBlock id <- [t]] +aarch64_jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]] aarch64_jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]] aarch64_jumpDestsOfInstr _ = [] @@ -329,7 +333,7 @@ aarch64_patchJumpInstr instr patchF CBNZ r (TBlock bid) -> CBNZ r (TBlock (patchF bid)) J (TBlock bid) -> J (TBlock (patchF bid)) B (TBlock bid) -> B (TBlock (patchF bid)) - BL (TBlock bid) -> BL (TBlock (patchF bid)) + BL (TBlock bid) ps rs -> BL (TBlock (patchF bid)) ps rs BCOND c (TBlock bid) -> BCOND c (TBlock (patchF bid)) _ -> pprPanic "patchJumpInstr" (text $ show instr) @@ -337,100 +341,98 @@ aarch64_patchJumpInstr instr patchF -- | An instruction to spill a register into a spill slot. aarch64_mkSpillInstr - :: NCGConfig + :: HasCallStack + => NCGConfig -> Reg -- register to spill -> Int -- current stack delta -> Int -- spill slot to use - -> Instr --- XXX this is stupid. We essentially do sp <- sp - 4095; str xN, [sp - ...] ; sp <- sp + 4095 -{- -aarch64_mkSpillInstr config reg delta slot | (spillSlotToOffset config slot) - delta > 4095 - = let (!d, !isns) = traceShow msg $ aarch64_mkSpillInstr config reg (delta + delta') slot - in traceShow "Spill(1) ret" (d, subIsn : isns ++ [addIsn]) - where delta' = 4095 - !addIsn = ADD sp sp (OpImm (ImmInt delta')) - !subIsn = SUB sp sp (OpImm (ImmInt delta')) - msg = "Spill(1): " ++ show (spillSlotToOffset config slot) ++ "; Delta: " ++ show delta ++ " -> " ++ show (delta + delta') - -aarch64_mkSpillInstr config reg delta slot | (spillSlotToOffset config slot) - delta > 255 - = let (!d, !isns) = traceShow msg $ aarch64_mkSpillInstr config reg (delta + delta') slot - in traceShow "Spill(2) ret" (d, subIsn : isns ++ [addIsn]) - where delta' = (spillSlotToOffset config slot) - delta - !addIsn = ADD sp sp (OpImm (ImmInt delta')) - !subIsn = SUB sp sp (OpImm (ImmInt delta')) - msg = "Spill(2): " ++ show (spillSlotToOffset config slot) ++ "; Delta: " ++ show delta ++ " -> " ++ show (delta + delta') - -aarch64_mkSpillInstr config reg delta slot | (spillSlotToOffset config slot) - delta < -4095 - = let (!d, !isns) = traceShow msg $ aarch64_mkSpillInstr config reg (delta - delta') slot - in traceShow "Spill(3) ret" (d, addIsn : isns ++ [subIsn]) - where delta' = 4095 - !addIsn = ADD sp sp (OpImm (ImmInt delta')) - !subIsn = SUB sp sp (OpImm (ImmInt delta')) - msg = "Spill(3): " ++ show (spillSlotToOffset config slot) ++ "; Delta: " ++ show delta ++ " -> " ++ show (delta + delta') - -aarch64_mkSpillInstr config reg delta slot | (spillSlotToOffset config slot) - delta < -256 - = let (!d, !isns) = traceShow msg $ aarch64_mkSpillInstr config reg (delta + delta') slot - in traceShow "Spill(4) ret" (d, subIsn : isns ++ [addIsn]) - where delta' = (spillSlotToOffset config slot) - delta - !addIsn = ADD sp sp (OpImm (ImmInt delta')) - !subIsn = SUB sp sp (OpImm (ImmInt delta')) - msg = "Spill(4): " ++ show (spillSlotToOffset config slot) ++ "; Delta: " ++ show delta ++ " -> " ++ show (delta + delta') --} -aarch64_mkSpillInstr config reg delta slot - = --[ - -- ANN (text "Spill") $ - -- traceShow ("Spill: " ++ show (off - delta)) $ - STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt $ off - delta))) - --] + -> [Instr] + +-- Alright, so here's the plan. On aarch64, we can't spill into arbitrary locations, +-- the range is essentially [-256,255], or [0, 0xFFF]*8 = [0, 32760] for 64bits. For +-- other ranges we need to adjust SP first; we should strive to keep it 16byte aligned. +-- +-- To adjust for other range, we can use ADD/SUB, with a positive immediate of [0, 0xFFF], +-- or [0, 0xFFF] << 12. + +aarch64_mkSpillInstr config reg delta slot = + case (spillSlotToOffset config slot) - delta of + imm | -256 <= imm && imm <= 255 -> [ mkStr imm ] + imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkStr imm ] + imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkAdd (imm .&~. 0xfff) + , mkStr (imm .&. 0xfff) + , mkSub (imm .&~. 0xfff) ] + -- imm | imm > 0xfff && imm <= 0xffffff -> [ mkAdd (imm .&~. 0xfff) + -- , mkAdd (imm .&. 0xff0) + -- , mkStr (imm .&. 0x00f) + -- , mkSub (imm .&. 0xff0) + -- , mkSub (imm .&~. 0xfff) ] + -- if we have a negative offset, well subtract another 0x1000 from it, and then + -- use the positive + -- imm | -imm > 0xfff && -imm <= 0xffefff && imm .&. 0x7 == 0x0 -> [ mkSub (-imm .&~. 0xfff + 0x1000) + -- , mkStr (0x1000 - (-imm .&. 0xfff)) + -- , mkAdd (-imm .&~. 0xfff + 0x1000) ] + -- imm | -imm > 0xfff && -imm <= 0xffffff -> [ mkSub (-imm .&~. 0xfff) + -- , mkSub (-imm .&. 0xff0) + -- , mkStr (-(-imm .&. 0x00f)) + -- , mkAdd (-imm .&. 0xff0) + -- , mkAdd (-imm .&~. 0xfff) ] + imm -> pprPanic "aarch64_mkSpillInstr" (text "Unable to spill into" <+> int imm) where + a .&~. b = a .&. (complement b) + fmt = case reg of RegReal (RealRegSingle n) | n < 32 -> II64 _ -> FF64 + + mkStr imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) + mkAdd imm = ANN (text "Spill Add") $ ADD sp sp (OpImm (ImmInt imm)) + mkSub imm = ANN (text "Spill Sub") $ SUB sp sp (OpImm (ImmInt imm)) + off = spillSlotToOffset config slot +-- fails in compiler/stage2/build/GHC/Driver/Pipeline.o aarch64_mkLoadInstr :: NCGConfig -> Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use - -> Instr --- XXX this is stupid. We essentially do sp <- sp - 4095; str xN, [sp - ...] ; sp <- sp + 4095 -{- -aarch64_mkLoadInstr config reg delta slot | (spillSlotToOffset config slot) - delta > 4095 - = let (!d, !isns) = traceShow msg $ aarch64_mkLoadInstr config reg (delta + delta') slot - in traceShow "Reload(1) ret" (d, SUB sp sp (OpImm (ImmInt 4095)) : isns ++ [ADD sp sp (OpImm (ImmInt 4095))]) - where delta' = 4095 - msg = "Reload(1): " ++ show (spillSlotToOffset config slot) ++ "; Delta: " ++ show delta ++ " -> " ++ show (delta + delta') - -aarch64_mkLoadInstr config reg delta slot | (spillSlotToOffset config slot) - delta > 255 - = let (!d, !isns) = traceShow msg $ aarch64_mkLoadInstr config reg (delta + delta') slot - in traceShow "Reload(2) ret" (d, SUB sp sp (OpImm (ImmInt delta')) : isns ++ [ADD sp sp (OpImm (ImmInt delta'))]) - where delta' = (spillSlotToOffset config slot) - delta - msg = "Reload(2): " ++ show (spillSlotToOffset config slot) ++ "; Delta: " ++ show delta ++ " -> " ++ show (delta + delta') - -aarch64_mkLoadInstr config reg delta slot | (spillSlotToOffset config slot) - delta < -4095 - = let (!d, !isns) = traceShow msg $ aarch64_mkLoadInstr config reg (delta + delta') slot - in traceShow "Reload(3) ret" (d, ADD sp sp (OpImm (ImmInt 4095)) : isns ++ [SUB sp sp (OpImm (ImmInt 4095))]) - where delta' = -4095 - msg = "Reload(3): " ++ show (spillSlotToOffset config slot) ++ "; Delta: " ++ show delta ++ " -> " ++ show (delta + delta') - -aarch64_mkLoadInstr config reg delta slot | (spillSlotToOffset config slot) - delta < -256 - = let (!d, !isns) = traceShow msg $ aarch64_mkLoadInstr config reg (delta + delta') slot - in traceShow "Reload(4) ret" (d, SUB sp sp (OpImm (ImmInt delta')) : isns ++ [ADD sp sp (OpImm (ImmInt delta'))]) - where delta' = (spillSlotToOffset config slot) - delta - msg = "Reload(4): " ++ show (spillSlotToOffset config slot) ++ "; Delta: " ++ show delta ++ " -> " ++ show (delta + delta') - --} -aarch64_mkLoadInstr config reg delta slot - = --[ - -- ANN (text "Reload") $ - -- traceShow ("Reload: " ++ show (off - delta)) $ - LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt $ off - delta))) - -- ] + -> [Instr] + +aarch64_mkLoadInstr config reg delta slot = + case (spillSlotToOffset config slot) - delta of + imm | -256 <= imm && imm <= 255 -> [ mkLdr imm ] + imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkLdr imm ] + imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkAdd (imm .&~. 0xfff) + , mkLdr (imm .&. 0xfff) + , mkSub (imm .&~. 0xfff) ] + -- imm | imm > 0xfff && imm <= 0xffffff -> [ mkAdd (imm .&~. 0xfff) + -- , mkAdd (imm .&. 0xff0) + -- , mkLdr (imm .&. 0x00f) + -- , mkSub (imm .&. 0xff0) + -- , mkSub (imm .&~. 0xfff) ] + -- if we have a negative offset, well subtract another 0x1000 from it, and then + -- use the positive + -- imm | -imm > 0xfff && -imm <= 0xffefff && imm .&. 0x7 == 0x0 -> [ mkSub (-imm .&~. 0xfff + 0x1000) + -- , mkLdr (0x1000 - (-imm .&. 0xfff)) + -- , mkAdd (-imm .&~. 0xfff + 0x1000) ] + -- imm | -imm > 0xfff && -imm <= 0xffffff -> [ mkSub (-imm .&~. 0xfff) + -- , mkSub (-imm .&. 0xff0) + -- , mkLdr (-(-imm .&. 0x00f)) + -- , mkAdd (-imm .&. 0xff0) + -- , mkAdd (-imm .&~. 0xfff) ] + imm -> pprPanic "aarch64_mkSpillInstr" (text "Unable to spill into" <+> int imm) where + a .&~. b = a .&. (complement b) + fmt = case reg of RegReal (RealRegSingle n) | n < 32 -> II64 _ -> FF64 + + mkLdr imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) + mkAdd imm = ANN (text "Reload Add") $ ADD sp sp (OpImm (ImmInt imm)) + mkSub imm = ANN (text "Reload Sub") $ SUB sp sp (OpImm (ImmInt imm)) + off = spillSlotToOffset config slot -------------------------------------------------------------------------------- @@ -458,30 +460,12 @@ aarch64_isMetaInstr instr -- | Copy the value in a register to another one. -- Must work for all register classes. aarch64_mkRegRegMoveInstr :: Reg -> Reg -> Instr -aarch64_mkRegRegMoveInstr src dst = MOV (OpReg W64 dst) (OpReg W64 src) +aarch64_mkRegRegMoveInstr src dst = ANN (text $ "Reg->Reg Move: " ++ show src ++ " -> " ++ show dst) $ MOV (OpReg W64 dst) (OpReg W64 src) -- | Take the source and destination from this reg -> reg move instruction -- or Nothing if it's not one aarch64_takeRegRegMoveInstr :: Instr -> Maybe (Reg,Reg) --- XXX: *if* we enable this here, we run into the elimination shortcut in --- Linear.hs:441, which does not ensure that the register is free'd --- before it's reused. This seesm to be an issue if we have two function --- calls in the same block. --- --- y = f a b --- --- will generate: --- mov x0 a --- mov x1 b --- bl f --- mov y x0 --- --- We'll elimitate the last mov y x0 call, and alias x0 = y. --- --- No we'll need to reuse x0 for the next function, and when we --- try to allocate it, it's already allocated. --- ---aarch64_takeRegRegMoveInstr (MOV (OpReg dst) (OpReg src)) = Just (src, dst) +--aarch64_takeRegRegMoveInstr (MOV (OpReg fmt dst) (OpReg fmt' src)) | fmt == fmt' = Just (src, dst) aarch64_takeRegRegMoveInstr _ = Nothing -- | Make an unconditional jump instruction. @@ -491,15 +475,15 @@ aarch64_mkJumpInstr id = [B (TBlock id)] aarch64_mkStackAllocInstr :: Platform -> Int -> [Instr] aarch64_mkStackAllocInstr platform n | n == 0 = [] - | n > 0 && n < 4096 = [ SUB sp sp (OpImm (ImmInt n)) ] - | n > 0 = SUB sp sp (OpImm (ImmInt 4095)) : aarch64_mkStackAllocInstr platform (n - 4095) + | n > 0 && n < 4096 = [ ANN (text "Alloc More Stack") $ SUB sp sp (OpImm (ImmInt n)) ] + | n > 0 = ANN (text "Alloc More Stack") (SUB sp sp (OpImm (ImmInt 4095))) : aarch64_mkStackAllocInstr platform (n - 4095) aarch64_mkStackAllocInstr platform n = pprPanic "aarch64_mkStackAllocInstr" (int n) aarch64_mkStackDeallocInstr :: Platform -> Int -> [Instr] aarch64_mkStackDeallocInstr platform n | n == 0 = [] - | n > 0 && n < 4096 = [ ADD sp sp (OpImm (ImmInt n)) ] - | n > 0 = ADD sp sp (OpImm (ImmInt 4095)) : aarch64_mkStackDeallocInstr platform (n + 4095) + | n > 0 && n < 4096 = [ ANN (text "Dealloc More Stack") $ ADD sp sp (OpImm (ImmInt n)) ] + | n > 0 = ANN (text "Dealloc More Stack") (ADD sp sp (OpImm (ImmInt 4095))) : aarch64_mkStackDeallocInstr platform (n - 4095) aarch64_mkStackDeallocInstr platform n = pprPanic "aarch64_mkStackDeallocInstr" (int n) -- @@ -540,6 +524,7 @@ allocMoreStack platform slots proc@(CmmProc info lbl live (ListGraph code)) = do insert_dealloc insn r = case insn of J _ -> dealloc ++ (insn : r) + ANN _ (J _) -> dealloc ++ (insn : r) _other | aarch64_jumpDestsOfInstr insn /= [] -> aarch64_patchJumpInstr insn retarget : r _other -> insn : r @@ -669,7 +654,7 @@ data Instr -- Branching. | J Target -- like B, but only generated from genJump. Used to distinguish genJumps from others. | B Target -- unconditional branching b/br. (To a blockid, label or register) - | BL Target -- branch and link (e.g. set x30 to next pc, and branch) + | BL Target [Reg] [Reg] -- branch and link (e.g. set x30 to next pc, and branch) | BCOND Cond Target -- branch with condition. b. -- 8. Synchronization Instructions ----------------------------------------- ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -449,13 +449,13 @@ pprInstr platform instr = case instr of -- 4. Branch Instructions ---------------------------------------------------- J t -> pprInstr platform (B t) - B (TBlock bid) -> text "\tbl" <+> ppr (mkLocalBlockLabel (getUnique bid)) - B (TLabel lbl) -> text "\tbl" <+> ppr lbl - B (TReg r) -> text "\tblr" <+> pprReg W64 r + B (TBlock bid) -> text "\tb" <+> ppr (mkLocalBlockLabel (getUnique bid)) + B (TLabel lbl) -> text "\tb" <+> ppr lbl + B (TReg r) -> text "\tbr" <+> pprReg W64 r - BL (TBlock bid) -> text "\tbl" <+> ppr (mkLocalBlockLabel (getUnique bid)) - BL (TLabel lbl) -> text "\tbl" <+> ppr lbl - BL (TReg r) -> text "\tblr" <+> pprReg W64 r + BL (TBlock bid) _ _ -> text "\tbl" <+> ppr (mkLocalBlockLabel (getUnique bid)) + BL (TLabel lbl) _ _ -> text "\tbl" <+> ppr lbl + BL (TReg r) _ _ -> text "\tblr" <+> pprReg W64 r BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> ppr (mkLocalBlockLabel (getUnique bid)) BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> ppr lbl @@ -477,38 +477,38 @@ pprInstr platform instr = case instr of -- NOTE: GHC may do whacky things where it only load the lower part of an -- address. Not observing the correct size when loading will lead -- inevitably to crashes. - STR f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> + STR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> text "\tstrb" <+> pprOp o1 <> comma <+> pprOp o2 - STR f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> + STR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> text "\tstrh" <+> pprOp o1 <> comma <+> pprOp o2 - STR f o1 o2 -> text "\tstr" <+> pprOp o1 <> comma <+> pprOp o2 + STR _f o1 o2 -> text "\tstr" <+> pprOp o1 <> comma <+> pprOp o2 - LDR f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> + LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> text "\tadrp" <+> pprOp o1 <> comma <+> text ":got:" <> ppr lbl $$ text "\tldr" <+> pprOp o1 <> comma <+> text "[" <> pprOp o1 <> comma <+> text ":got_lo12:" <> ppr lbl <> text "]" $$ text "\tadd" <+> pprOp o1 <> comma <+> pprOp o1 <> comma <+> char '#' <> int off -- XXX: check that off is in 12bits. - LDR f o1 (OpImm (ImmIndex lbl off)) -> + LDR _f o1 (OpImm (ImmIndex lbl off)) -> text "\tadrp" <+> pprOp o1 <> comma <+> ppr lbl $$ text "\tadd" <+> pprOp o1 <> comma <+> pprOp o1 <> comma <+> text ":lo12:" <> ppr lbl $$ text "\tadd" <+> pprOp o1 <> comma <+> pprOp o1 <> comma <+> char '#' <> int off -- XXX: check that off is in 12bits. - LDR f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> + LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' -> text "\tadrp" <+> pprOp o1 <> comma <+> text ":got:" <> ppr lbl $$ text "\tldr" <+> pprOp o1 <> comma <+> text "[" <> pprOp o1 <> comma <+> text ":got_lo12:" <> ppr lbl <> text "]" - LDR f o1 (OpImm (ImmCLbl lbl)) -> + LDR _f o1 (OpImm (ImmCLbl lbl)) -> text "\tadrp" <+> pprOp o1 <> comma <+> ppr lbl $$ text "\tadd" <+> pprOp o1 <> comma <+> pprOp o1 <> comma <+> text ":lo12:" <> ppr lbl - LDR f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> + LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 -> text "\tldrsb" <+> pprOp o1 <> comma <+> pprOp o2 - LDR f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> + LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 -> text "\tldrsh" <+> pprOp o1 <> comma <+> pprOp o2 - LDR f o1 o2 -> text "\tldr" <+> pprOp o1 <> comma <+> pprOp o2 + LDR _f o1 o2 -> text "\tldr" <+> pprOp o1 <> comma <+> pprOp o2 - STP f o1 o2 o3 -> text "\tstp" <+> pprOp o1 <> comma <+> pprOp o2 <> comma <+> pprOp o3 - LDP f o1 o2 o3 -> text "\tldp" <+> pprOp o1 <> comma <+> pprOp o2 <> comma <+> pprOp o3 + STP _f o1 o2 o3 -> text "\tstp" <+> pprOp o1 <> comma <+> pprOp o2 <> comma <+> pprOp o3 + LDP _f o1 o2 o3 -> text "\tldp" <+> pprOp o1 <> comma <+> pprOp o2 <> comma <+> pprOp o3 -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> text "\tdmb sy" ===================================== compiler/GHC/CmmToAsm/Instr.hs ===================================== @@ -26,6 +26,10 @@ import GHC.Cmm hiding (topInfoTable) import GHC.CmmToAsm.Config +import GHC.Utils.Outputable (SDoc) + +import GHC.Stack + -- | Holds a list of source and destination registers used by a -- particular instruction. -- @@ -137,20 +141,22 @@ class Instruction instr where -- | An instruction to spill a register into a spill slot. mkSpillInstr - :: NCGConfig + :: HasCallStack + => NCGConfig -> Reg -- ^ the reg to spill -> Int -- ^ the current stack delta -> Int -- ^ spill slot to use - -> instr -- ^ instructions + -> [instr] -- ^ instructions -- | An instruction to reload a register from a spill slot. mkLoadInstr - :: NCGConfig + :: HasCallStack + => NCGConfig -> Reg -- ^ the reg to reload. -> Int -- ^ the current stack delta -> Int -- ^ the spill slot to use - -> instr -- ^ instructions + -> [instr] -- ^ instructions -- | See if this instruction is telling us the current C stack delta takeDeltaInstr @@ -205,3 +211,6 @@ class Instruction instr where :: Platform -> Int -> [instr] + + -- Create a comment instruction + mkComment :: SDoc -> [instr] ===================================== compiler/GHC/CmmToAsm/PIC.hs ===================================== @@ -268,11 +268,15 @@ howToAccessLabel config _ OSMinGW32 this_mod _ lbl -- is enough for ~64MB of range. Anything else will need to go through a veneer, -- which is the job of the linker to build. We might only want to lookup -- Data References through the GOT. --- howToAccessLabel _config ArchAArch64 _os _this_mod kind _lbl --- = case kind of --- DataReference -> AccessDirectly -- AccessViaSymbolPtr --- CallReference -> AccessDirectly --- JumpReference -> AccessDirectly +howToAccessLabel config ArchAArch64 _os this_mod kind lbl + | not (ncgExternalDynamicRefs config) + = AccessDirectly + + | labelDynamic config this_mod lbl + = AccessViaSymbolPtr + + | otherwise + = AccessDirectly -- Mach-O (Darwin, Mac OS X) ===================================== compiler/GHC/CmmToAsm/PPC/Instr.hs ===================================== @@ -76,6 +76,7 @@ instance Instruction Instr where mkJumpInstr = ppc_mkJumpInstr mkStackAllocInstr = ppc_mkStackAllocInstr mkStackDeallocInstr = ppc_mkStackDeallocInstr + mkComment = const [] ppc_mkStackAllocInstr :: Platform -> Int -> [Instr] @@ -541,7 +542,7 @@ ppc_mkSpillInstr -> Reg -- register to spill -> Int -- current stack delta -> Int -- spill slot to use - -> Instr + -> [Instr] ppc_mkSpillInstr config reg delta slot = let platform = ncgPlatform config @@ -558,7 +559,7 @@ ppc_mkSpillInstr config reg delta slot Just _ -> ST Nothing -> STFAR -- pseudo instruction: 32 bit offsets - in instr fmt reg (AddrRegImm sp (ImmInt (off-delta))) + in [instr fmt reg (AddrRegImm sp (ImmInt (off-delta)))] ppc_mkLoadInstr @@ -566,7 +567,7 @@ ppc_mkLoadInstr -> Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use - -> Instr + -> [Instr] ppc_mkLoadInstr config reg delta slot = let platform = ncgPlatform config @@ -583,7 +584,7 @@ ppc_mkLoadInstr config reg delta slot Just _ -> LD Nothing -> LDFAR -- pseudo instruction: 32 bit offsets - in instr fmt reg (AddrRegImm sp (ImmInt (off-delta))) + in [instr fmt reg (AddrRegImm sp (ImmInt (off-delta)))] -- | The size of a minimal stackframe header including minimal ===================================== compiler/GHC/CmmToAsm/Reg/Linear.hs ===================================== @@ -256,7 +256,7 @@ linearRegAlloc' config initFreeRegs entry_ids block_live sccs return (blocks, stats, getStackUse stack) -linearRA_SCCs :: OutputableRegConstraint freeRegs instr +linearRA_SCCs :: (HasCallStack, OutputableRegConstraint freeRegs instr) => [BlockId] -> BlockMap RegSet -> [NatBasicBlock instr] @@ -291,7 +291,7 @@ linearRA_SCCs entry_ids block_live blocksAcc (CyclicSCC blocks : sccs) more sanity checking to guard against this eventuality. -} -process :: OutputableRegConstraint freeRegs instr +process :: (HasCallStack, OutputableRegConstraint freeRegs instr) => [BlockId] -> BlockMap RegSet -> [GenBasicBlock (LiveInstr instr)] @@ -335,7 +335,7 @@ process entry_ids block_live (b@(BasicBlock id _) : blocks) -- | Do register allocation on this basic block -- processBlock - :: OutputableRegConstraint freeRegs instr + :: (HasCallStack, OutputableRegConstraint freeRegs instr) => BlockMap RegSet -- ^ live regs on entry to each basic block -> LiveBasicBlock instr -- ^ block to do register allocation on -> RegM freeRegs [NatBasicBlock instr] -- ^ block with registers allocated @@ -382,7 +382,7 @@ initBlock id block_live -- | Do allocation for a sequence of instructions. linearRA - :: OutputableRegConstraint freeRegs instr + :: (HasCallStack, OutputableRegConstraint freeRegs instr) => BlockMap RegSet -- ^ map of what vregs are live on entry to each block. -> [instr] -- ^ accumulator for instructions already processed. -> [NatBasicBlock instr] -- ^ accumulator for blocks of fixup code. @@ -409,7 +409,7 @@ linearRA block_live accInstr accFixups id (instr:instrs) -- | Do allocation for a single instruction. raInsn - :: OutputableRegConstraint freeRegs instr + :: (HasCallStack, OutputableRegConstraint freeRegs instr) => BlockMap RegSet -- ^ map of what vregs are love on entry to each block. -> [instr] -- ^ accumulator for instructions already processed. -> BlockId -- ^ the id of the current block, for debugging @@ -489,7 +489,7 @@ isInReg src assig | Just (InReg _) <- lookupUFM assig src = True | otherwise = False -genRaInsn :: (OutputableRegConstraint freeRegs instr) +genRaInsn :: (HasCallStack, OutputableRegConstraint freeRegs instr) => BlockMap RegSet -> [instr] -> BlockId @@ -499,7 +499,7 @@ genRaInsn :: (OutputableRegConstraint freeRegs instr) -> RegM freeRegs ([instr], [NatBasicBlock instr]) genRaInsn block_live new_instrs block_id instr r_dying w_dying = do --- pprTraceM "genRaInsn" $ ppr (block_id, instr) +-- pprTraceM "genRaInsn" $ ppr (block_id, instr) platform <- getPlatform case regUsageOfInstr platform instr of { RU read written -> do @@ -509,10 +509,10 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do -- we don't need to do anything with real registers that are -- only read by this instr. (the list is typically ~2 elements, -- so using nub isn't a problem). - let real_read = nub [ rr | (RegReal rr) <- read] let virt_read = nub [ vr | (RegVirtual vr) <- read ] -- do +-- let real_read = nub [ rr | (RegReal rr) <- read] -- freeregs <- getFreeRegsR -- assig <- getAssigR @@ -589,8 +589,27 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do | src == dst -> [] _ -> [patched_instr] - let code = squashed_instr ++ w_spills ++ reverse r_spills - ++ clobber_saves ++ new_instrs + -- On the use of @reverse@ below. + -- Since we can now have spills and reloads produce multiple instructions + -- we need to ensure they are emitted in the correct order. Previously + -- we did not, as mkSpill/mkReload/mkRegRegMove produced single instructions + -- only and as such order didn't matter. Now it does. And reversing the + -- spills (clobber will also spill), will ensure they are emitted in the + -- right order. + + -- u <- getUniqueR + let code = -- mkComment (text " ppr u <> text ")>") + -- ++ mkComment (text " ppr u <> text "):squashed>")] ++ + squashed_instr + -- ++ mkComment (text " ppr u <> text "):w_spills>") + ++ reverse w_spills + -- ++ mkComment (text " ppr u <> text "):r_spills>") + ++ reverse r_spills + -- ++ mkComment (text " ppr u <> text "):clobber_saves>") + ++ reverse clobber_saves + -- ++ mkComment (text " ppr u <> text "):new_instrs>") + ++ new_instrs + -- ++ mkComment (text " ppr u <> text ")>") -- pprTrace "patched-code" ((vcat $ map (docToSDoc . pprInstr) code)) $ do -- pprTrace "pached-fixup" ((ppr fixup_blocks)) $ do @@ -642,7 +661,7 @@ releaseRegs regs = do -- saveClobberedTemps - :: (Instruction instr, FR freeRegs) + :: (HasCallStack, Instruction instr, FR freeRegs) => [RealReg] -- real registers clobbered by this instruction -> [Reg] -- registers which are no longer live after this insn -> RegM freeRegs [instr] -- return: instructions to spill any temps that will @@ -665,9 +684,11 @@ saveClobberedTemps clobbered dying (instrs,assig') <- clobber assig [] to_spill setAssigR assig' - return instrs - + return $ -- mkComment (text "") ++ + instrs +-- ++ mkComment (text "") where +-- clobber :: UniqFM Loc -> [instr] -> [(Unique, RealReg)] -> RegM freeRegs ([instr], UniqFM Loc) clobber assig instrs [] = return (instrs, assig) @@ -701,7 +722,7 @@ saveClobberedTemps clobbered dying let new_assign = addToUFM assig temp (InBoth reg slot) - clobber new_assign (spill : instrs) rest + clobber new_assign (spill ++ instrs) rest @@ -716,8 +737,6 @@ clobberRegs clobbered = do platform <- getPlatform freeregs <- getFreeRegsR - config <- getConfig - let gpRegs = frGetFreeRegs platform RcInteger freeregs :: [RealReg] fltRegs = frGetFreeRegs platform RcFloat freeregs :: [RealReg] dblRegs = frGetFreeRegs platform RcDouble freeregs :: [RealReg] @@ -773,7 +792,7 @@ data SpillLoc = ReadMem StackSlot -- reading from register only in memory -- the list of free registers and free stack slots. allocateRegsAndSpill - :: forall freeRegs instr. (FR freeRegs, Outputable instr, Instruction instr) + :: forall freeRegs instr. (HasCallStack, FR freeRegs, Outputable instr, Instruction instr) => Bool -- True <=> reading (load up spilled regs) -> [VirtualReg] -- don't push these out -> [instr] -- spill insns @@ -839,7 +858,7 @@ findPrefRealReg vreg = do -- reading is redundant with reason, but we keep it around because it's -- convenient and it maintains the recursive structure of the allocator. -- EZY -allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr) +allocRegsAndSpill_spill :: (HasCallStack, FR freeRegs, Instruction instr, Outputable instr) => Bool -> [VirtualReg] -> [instr] @@ -919,10 +938,7 @@ allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc | (temp_to_push_out, (my_reg :: RealReg)) : _ <- candidates_inReg = do - (spill_insn, slot) <- spillR (RegReal my_reg) temp_to_push_out - let spill_store = (if reading then id else reverse) - -- COMMENT (fsLit "spill alloc"): - [spill_insn] + (spill_store, slot) <- spillR (RegReal my_reg) temp_to_push_out -- record that this temp was spilled recordSpill (SpillAlloc temp_to_push_out) @@ -972,7 +988,7 @@ loadTemp vreg (ReadMem slot) hreg spills = do insn <- loadR (RegReal hreg) slot recordSpill (SpillLoad $ getUnique vreg) - return $ {- COMMENT (fsLit "spill load") : -} insn : spills + return $ {- mkComment (text "spill load") : -} insn ++ spills loadTemp _ _ _ spills = return spills ===================================== compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs ===================================== @@ -24,10 +24,13 @@ import GHC.Cmm.BlockId import GHC.Cmm.Dataflow.Collections import GHC.Data.Graph.Directed import GHC.Utils.Outputable +import GHC.Utils.Monad (concatMapM) import GHC.Types.Unique import GHC.Types.Unique.FM import GHC.Types.Unique.Set +import GHC.Stack + -- | For a jump instruction at the end of a block, generate fixup code so its -- vregs are in the correct regs for its destination. -- @@ -295,7 +298,7 @@ expandNode vreg src dst -- cycles in expandNode above. -- handleComponent - :: Instruction instr + :: (HasCallStack, Instruction instr) => Int -> instr -> SCC (Node Loc Unique) -> RegM freeRegs [instr] @@ -304,7 +307,7 @@ handleComponent -- go via a spill slot. -- handleComponent delta _ (AcyclicSCC (DigraphNode vreg src dsts)) - = mapM (makeMove delta vreg src) dsts + = concatMapM (makeMove delta vreg src) dsts -- Handle some cyclic moves. @@ -338,7 +341,7 @@ handleComponent delta instr -- make sure to do all the reloads after all the spills, -- so we don't end up clobbering the source values. - return ([instrSpill] ++ concat remainingFixUps ++ [instrLoad]) + return (instrSpill ++ concat remainingFixUps ++ instrLoad) handleComponent _ _ (CyclicSCC _) = panic "Register Allocator: handleComponent cyclic" @@ -347,12 +350,12 @@ handleComponent _ _ (CyclicSCC _) -- | Move a vreg between these two locations. -- makeMove - :: Instruction instr + :: (HasCallStack, Instruction instr) => Int -- ^ current C stack delta. -> Unique -- ^ unique of the vreg that we're moving. -> Loc -- ^ source location. -> Loc -- ^ destination location. - -> RegM freeRegs instr -- ^ move instruction. + -> RegM freeRegs [instr] -- ^ move instruction. makeMove delta vreg src dst = do config <- getConfig @@ -361,7 +364,7 @@ makeMove delta vreg src dst case (src, dst) of (InReg s, InReg d) -> do recordSpill (SpillJoinRR vreg) - return $ mkRegRegMoveInstr platform (RegReal s) (RegReal d) + return $ [mkRegRegMoveInstr platform (RegReal s) (RegReal d)] (InMem s, InReg d) -> do recordSpill (SpillJoinRM vreg) return $ mkLoadInstr config (RegReal d) delta s ===================================== compiler/GHC/CmmToAsm/Reg/Linear/State.hs ===================================== @@ -55,6 +55,7 @@ import GHC.Types.Unique import GHC.Types.Unique.Supply import Control.Monad (ap) +import GHC.Stack -- Avoids using unboxed tuples when loading into GHCi #if !defined(GHC_LOADED_INTO_GHCI) @@ -126,8 +127,8 @@ makeRAStats state , ra_fixupList = ra_fixups state } -spillR :: Instruction instr - => Reg -> Unique -> RegM freeRegs (instr, Int) +spillR :: (HasCallStack, Instruction instr) + => Reg -> Unique -> RegM freeRegs ([instr], Int) spillR reg temp = RegM $ \s -> let (stack1,slot) = getStackSlotFor (ra_stack s) temp @@ -137,7 +138,7 @@ spillR reg temp = RegM $ \s -> loadR :: Instruction instr - => Reg -> Int -> RegM freeRegs instr + => Reg -> Int -> RegM freeRegs [instr] loadR reg slot = RegM $ \s -> RA_Result s (mkLoadInstr (ra_config s) reg (ra_delta s) slot) ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -518,7 +518,7 @@ stripLiveBlock -> LiveBasicBlock instr -> NatBasicBlock instr -stripLiveBlock config (BasicBlock i lis) +stripLiveBlock _config (BasicBlock i lis) = BasicBlock i instrs' where (instrs', _) @@ -527,13 +527,15 @@ stripLiveBlock config (BasicBlock i lis) spillNat acc [] = return (reverse acc) - spillNat acc (LiveInstr (SPILL reg slot) _ : instrs) - = do delta <- get - spillNat (mkSpillInstr config reg delta slot : acc) instrs + spillNat _acc (LiveInstr (SPILL _reg _slot) _ : _instrs) + = error "dead code: spill" + -- do delta <- get + -- spillNat (mkSpillInstr config reg delta slot : acc) instrs - spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs) - = do delta <- get - spillNat (mkLoadInstr config reg delta slot : acc) instrs + spillNat _acc (LiveInstr (RELOAD _slot _reg) _ : _instrs) + = error "dead code: reload:" + -- do delta <- get + -- spillNat (mkLoadInstr config reg delta slot : acc) instrs spillNat acc (LiveInstr (Instr instr) _ : instrs) | Just i <- takeDeltaInstr instr ===================================== compiler/GHC/CmmToAsm/SPARC/Instr.hs ===================================== @@ -104,6 +104,7 @@ instance Instruction Instr where mkJumpInstr = sparc_mkJumpInstr mkStackAllocInstr = panic "no sparc_mkStackAllocInstr" mkStackDeallocInstr = panic "no sparc_mkStackDeallocInstr" + mkComment = const [] -- | SPARC instruction set. @@ -373,7 +374,7 @@ sparc_mkSpillInstr -> Reg -- ^ register to spill -> Int -- ^ current stack delta -> Int -- ^ spill slot to use - -> Instr + -> [Instr] sparc_mkSpillInstr config reg delta slot = let platform = ncgPlatform config @@ -384,7 +385,7 @@ sparc_mkSpillInstr config reg delta slot RcFloat -> FF32 RcDouble -> FF64 - in ST fmt reg (fpRel (negate off_w)) + in [ST fmt reg (fpRel (negate off_w))] -- | Make a spill reload instruction. @@ -393,7 +394,7 @@ sparc_mkLoadInstr -> Reg -- ^ register to load into -> Int -- ^ current stack delta -> Int -- ^ spill slot to use - -> Instr + -> [Instr] sparc_mkLoadInstr config reg delta slot = let platform = ncgPlatform config @@ -404,7 +405,7 @@ sparc_mkLoadInstr config reg delta slot RcFloat -> FF32 RcDouble -> FF64 - in LD fmt (fpRel (- off_w)) reg + in [LD fmt (fpRel (- off_w)) reg] -------------------------------------------------------------------------------- ===================================== compiler/GHC/CmmToAsm/X86/Instr.hs ===================================== @@ -71,6 +71,7 @@ instance Instruction Instr where mkJumpInstr = x86_mkJumpInstr mkStackAllocInstr = x86_mkStackAllocInstr mkStackDeallocInstr = x86_mkStackDeallocInstr + mkComment = const [] -- ----------------------------------------------------------------------------- @@ -668,15 +669,15 @@ x86_mkSpillInstr -> Reg -- register to spill -> Int -- current stack delta -> Int -- spill slot to use - -> Instr + -> [Instr] x86_mkSpillInstr config reg delta slot = let off = spillSlotToOffset platform slot - delta in case targetClassOfReg platform reg of - RcInteger -> MOV (archWordFormat is32Bit) - (OpReg reg) (OpAddr (spRel platform off)) - RcDouble -> MOV FF64 (OpReg reg) (OpAddr (spRel platform off)) + RcInteger -> [MOV (archWordFormat is32Bit) + (OpReg reg) (OpAddr (spRel platform off))] + RcDouble -> [MOV FF64 (OpReg reg) (OpAddr (spRel platform off))] _ -> panic "X86.mkSpillInstr: no match" where platform = ncgPlatform config is32Bit = target32Bit platform @@ -687,15 +688,15 @@ x86_mkLoadInstr -> Reg -- register to load -> Int -- current stack delta -> Int -- spill slot to use - -> Instr + -> [Instr] x86_mkLoadInstr config reg delta slot = let off = spillSlotToOffset platform slot - delta in case targetClassOfReg platform reg of - RcInteger -> MOV (archWordFormat is32Bit) - (OpAddr (spRel platform off)) (OpReg reg) - RcDouble -> MOV FF64 (OpAddr (spRel platform off)) (OpReg reg) + RcInteger -> [MOV (archWordFormat is32Bit) + (OpAddr (spRel platform off)) (OpReg reg)] + RcDouble -> [MOV FF64 (OpAddr (spRel platform off)) (OpReg reg)] _ -> panic "X86.x86_mkLoadInstr" where platform = ncgPlatform config is32Bit = target32Bit platform View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3dbc6ac67a0efac9eaabb5ea4623247fa717d189...d088f7d1af476d5bdc7cc750ce91e8f48ba222d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3dbc6ac67a0efac9eaabb5ea4623247fa717d189...d088f7d1af476d5bdc7cc750ce91e8f48ba222d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 17:26:53 2020 From: gitlab at gitlab.haskell.org (John Ericson) Date: Tue, 08 Sep 2020 13:26:53 -0400 Subject: [Git][ghc/ghc][wip/int64-everywhere] 8 commits: Make fixed-size `Int32#` and `Int64#` Message-ID: <5f57bedd33fc8_80b3f8495700e281108641b@gitlab.haskell.org.mail> John Ericson pushed to branch wip/int64-everywhere at Glasgow Haskell Compiler / GHC Commits: 1f52ce78 by John Ericson at 2020-09-08T11:48:22-04:00 Make fixed-size `Int32#` and `Int64#` The boxed Int64 uses Int64#, but Int32# still uses Int#. The 32-bit case is less pressing to change because it is not a source of brittle CPP---it is the same thing on all platforms. We need Int64/Word64 constant folding to avoid the let/app restriction on Core, so that is implemented now. 32-bit constant unfolding and 32-bit literals are left as follow-up. This is the bulk of #11953 ghc-bignum: add support for Word64#/Int64# on 64-bit arch Fix fingerprint Core generation Fix some tests Co-authored-by: Sylvain Henry <hsyl20 at gmail.com> - - - - - f2269e66 by John Ericson at 2020-09-08T11:48:22-04:00 Inline INT64 and WORD64 macros in primops.txt.pp The definition is now unconditional so there is no reason for that CPP. - - - - - 276b494c by Sylvain Henry at 2020-09-08T11:48:22-04:00 Fix toArgRep - - - - - b459551f by Sylvain Henry at 2020-09-08T11:48:22-04:00 Adapt rules from #16402 to Word64#/Int64# - - - - - ca51d791 by John Ericson at 2020-09-08T11:48:22-04:00 Copy enumFrom* implementations from Int/Word for Int64/Word64 Without this, we don't get proper list fusion. I think this sort of copying is OK for now, but we absolutely need something better if we are going to make `IntN` use `IntN#` for all `N`. The degree to which proper metaprogramming has been punted upon by factoring everything through the native-sized types is disconcerting. - - - - - 8994b35e by John Ericson at 2020-09-08T11:48:23-04:00 `integerFromInt64#` can be inlined when the word size is >= 64 bits Maybe this will help with the renaming test failure? - - - - - 32a5c849 by John Ericson at 2020-09-08T11:48:23-04:00 Add builtin rule for `divInt64#` and `modInt64#` - - - - - d8e97fdd by John Ericson at 2020-09-08T11:48:23-04:00 WIP: Add missing floats <-> int/word 64 rule and primops - - - - - 30 changed files: - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/MachOp.hs - compiler/GHC/CmmToAsm/CPrim.hs - compiler/GHC/CmmToAsm/PPC/CodeGen.hs - compiler/GHC/CmmToAsm/SPARC/CodeGen.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToC.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/TyCon.hs - compiler/GHC/CoreToByteCode.hs - compiler/GHC/HsToCore/Match/Literal.hs - compiler/GHC/Iface/Tidy/StaticPtrTable.hs - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/StgToCmm/ArgRep.hs - compiler/GHC/StgToCmm/Layout.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToCmm/Ticky.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Instance/Typeable.hs - compiler/GHC/Types/Literal.hs - compiler/GHC/Utils/Outputable.hs - includes/stg/Prim.h - libraries/base/GHC/Exts.hs - libraries/base/GHC/Float.hs - libraries/base/GHC/Float/ConversionUtils.hs - libraries/base/GHC/Float/RealFracMethods.hs - libraries/base/GHC/Int.hs - libraries/base/GHC/Integer.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e57c5969a0e4b3ad65fe029a23a742928449fd16...d8e97fddf37c900dce00bc6fe83fd588372d33c9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e57c5969a0e4b3ad65fe029a23a742928449fd16...d8e97fddf37c900dce00bc6fe83fd588372d33c9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 17:27:16 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Tue, 08 Sep 2020 13:27:16 -0400 Subject: [Git][ghc/ghc][wip/T18639-remove-generated-pragma] Remove GENERATED pragma, as it is not being used Message-ID: <5f57bef498f2a_80b3f8495700e28110868f6@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/T18639-remove-generated-pragma at Glasgow Haskell Compiler / GHC Commits: 28c79894 by Alan Zimmerman at 2020-09-08T18:26:43+01:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 18 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - testsuite/tests/ghc-api/annotations/T10313.stdout - testsuite/tests/ghc-api/annotations/T11430.stdout - testsuite/tests/ghc-api/annotations/Test10313.hs - testsuite/tests/ghc-api/annotations/Test11430.hs - testsuite/tests/ghc-api/annotations/stringSource.hs - testsuite/tests/ghc-api/annotations/t11430.hs - testsuite/tests/printer/Makefile - − testsuite/tests/printer/Ppr047.hs - testsuite/tests/printer/all.T - utils/haddock Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -838,21 +838,10 @@ data HsPragE p -- 'GHC.Parser.Annotation.AnnVal', -- 'GHC.Parser.Annotation.AnnClose' @'\#-}'@ - -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsPragTick -- A pragma introduced tick - (XTickPragma p) - SourceText -- Note [Pragma source text] in GHC.Types.Basic - (StringLiteral,(Int,Int),(Int,Int)) - -- external span for this tick - ((SourceText,SourceText),(SourceText,SourceText)) - -- Source text for the four integers used in the span. - -- See note [Pragma source text] in GHC.Types.Basic - | XHsPragE !(XXPragE p) type instance XSCC (GhcPass _) = NoExtField type instance XCoreAnn (GhcPass _) = NoExtField -type instance XTickPragma (GhcPass _) = NoExtField type instance XXPragE (GhcPass _) = NoExtCon -- | Located Haskell Tuple Argument @@ -1402,13 +1391,6 @@ instance Outputable (HsPragE (GhcPass p)) where -- no doublequotes if stl empty, for the case where the SCC was written -- without quotes. <+> pprWithSourceText stl (ftext lbl) <+> text "#-}" - ppr (HsPragTick _ st (StringLiteral sta s, (v1,v2), (v3,v4)) ((s1,s2),(s3,s4))) = - pprWithSourceText st (text "{-# GENERATED") - <+> pprWithSourceText sta (doubleQuotes $ ftext s) - <+> pprWithSourceText s1 (ppr v1) <+> char ':' <+> pprWithSourceText s2 (ppr v2) - <+> char '-' - <+> pprWithSourceText s3 (ppr v3) <+> char ':' <+> pprWithSourceText s4 (ppr v4) - <+> text "#-}" {- ************************************************************************ ===================================== compiler/GHC/HsToCore/Coverage.hs ===================================== @@ -618,10 +618,6 @@ addTickHsExpr (HsTick x t e) = addTickHsExpr (HsBinTick x t0 t1 e) = liftM (HsBinTick x t0 t1) (addTickLHsExprNever e) -addTickHsExpr (HsPragE _ HsPragTick{} (L pos e0)) = do - e2 <- allocTickBox (ExpBox False) False False pos $ - addTickHsExpr e0 - return $ unLoc e2 addTickHsExpr (HsPragE x p e) = liftM (HsPragE x p) (addTickLHsExpr e) addTickHsExpr e@(HsBracket {}) = return e ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -820,11 +820,6 @@ ds_prag_expr (HsPragSCC _ _ cc) expr = do Tick (ProfNote (mkUserCC nm mod_name (getLoc expr) flavour) count True) <$> dsLExpr expr else dsLExpr expr -ds_prag_expr (HsPragTick _ _ _ _) expr = do - dflags <- getDynFlags - if gopt Opt_Hpc dflags - then panic "dsExpr:HsPragTick" - else dsLExpr expr ------------------------------ dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1572,7 +1572,6 @@ repE (HsUnboundVar _ uv) = do repUnboundVar sname repE (XExpr (HsExpanded _ b)) = repE b repE e@(HsPragE _ HsPragSCC {} _) = notHandled "Cost centres" (ppr e) -repE e@(HsPragE _ HsPragTick {} _) = notHandled "Tick Pragma" (ppr e) repE e = notHandled "Expression form" (ppr e) ----------------------------------------------------------------------------- ===================================== compiler/GHC/Parser.y ===================================== @@ -514,7 +514,6 @@ are the most common patterns, rewritten as regular expressions for clarity: '{-# SOURCE' { L _ (ITsource_prag _) } '{-# RULES' { L _ (ITrules_prag _) } '{-# SCC' { L _ (ITscc_prag _)} - '{-# GENERATED' { L _ (ITgenerated_prag _) } '{-# DEPRECATED' { L _ (ITdeprecated_prag _) } '{-# WARNING' { L _ (ITwarning_prag _) } '{-# UNPACK' { L _ (ITunpack_prag _) } @@ -2525,8 +2524,7 @@ optSemi :: { ([Located Token],Bool) } {- Note [Pragmas and operator fixity] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -'prag_e' is an expression pragma, such as {-# SCC ... #-} or -{-# GENERATED ... #-}. +'prag_e' is an expression pragma, such as {-# SCC ... #-}. It must be used with care, or else #15730 happens. Consider this infix expression: @@ -2580,20 +2578,6 @@ prag_e :: { Located ([AddAnn], HsPragE GhcPs) } HsPragSCC noExtField (getSCC_PRAGs $1) (StringLiteral NoSourceText (getVARID $2))) } - | '{-# GENERATED' STRING INTEGER ':' INTEGER HYPHEN INTEGER ':' INTEGER '#-}' - { let getINT = fromInteger . il_value . getINTEGER in - sLL $1 $> $ ([mo $1,mj AnnVal $2 - ,mj AnnVal $3,mj AnnColon $4 - ,mj AnnVal $5] ++ $6 ++ - [mj AnnVal $7,mj AnnColon $8 - ,mj AnnVal $9,mc $10], - HsPragTick noExtField - (getGENERATED_PRAGs $1) - (getStringLiteral $2, - (getINT $3, getINT $5), - (getINT $7, getINT $9)) - ((getINTEGERs $3, getINTEGERs $5), - (getINTEGERs $7, getINTEGERs $9) )) } fexp :: { ECP } : fexp aexp { ECP $ superFunArg $ @@ -3700,7 +3684,6 @@ getRULES_PRAGs (L _ (ITrules_prag src)) = src getWARNING_PRAGs (L _ (ITwarning_prag src)) = src getDEPRECATED_PRAGs (L _ (ITdeprecated_prag src)) = src getSCC_PRAGs (L _ (ITscc_prag src)) = src -getGENERATED_PRAGs (L _ (ITgenerated_prag src)) = src getUNPACK_PRAGs (L _ (ITunpack_prag src)) = src getNOUNPACK_PRAGs (L _ (ITnounpack_prag src)) = src getANN_PRAGs (L _ (ITann_prag src)) = src ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -743,7 +743,6 @@ data Token | ITline_prag SourceText -- not usually produced, see 'UsePosPragsBit' | ITcolumn_prag SourceText -- not usually produced, see 'UsePosPragsBit' | ITscc_prag SourceText - | ITgenerated_prag SourceText | ITunpack_prag SourceText | ITnounpack_prag SourceText | ITann_prag SourceText @@ -3289,7 +3288,6 @@ oneWordPrags = Map.fromList [ ("warning", strtoken (\s -> ITwarning_prag (SourceText s))), ("deprecated", strtoken (\s -> ITdeprecated_prag (SourceText s))), ("scc", strtoken (\s -> ITscc_prag (SourceText s))), - ("generated", strtoken (\s -> ITgenerated_prag (SourceText s))), ("unpack", strtoken (\s -> ITunpack_prag (SourceText s))), ("nounpack", strtoken (\s -> ITnounpack_prag (SourceText s))), ("ann", strtoken (\s -> ITann_prag (SourceText s))), ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -243,7 +243,6 @@ rnExpr (HsPragE x prag expr) where rn_prag :: HsPragE GhcPs -> HsPragE GhcRn rn_prag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann - rn_prag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo rnExpr (HsLam x matches) = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1082,7 +1082,6 @@ tcExpr other _ = pprPanic "tcLExpr" (ppr other) tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc tcExprPrag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann -tcExprPrag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo {- ********************************************************************* ===================================== testsuite/tests/ghc-api/annotations/T10313.stdout ===================================== @@ -10,5 +10,4 @@ ([c], [(SourceText "foo\x63", fooc), (SourceText "b\x61r", bar)]), ([r], [(SourceText "foo1\x67", foo1g)]), ([s, t], [(SourceText "a\x62", ab)]), - ([s, c], [(SourceText "foo\x64", food)]), - ([t, p], [(SourceText "foob\x61r", foobar)])] + ([s, c], [(SourceText "foo\x64", food)])] ===================================== testsuite/tests/ghc-api/annotations/T11430.stdout ===================================== @@ -3,4 +3,3 @@ ("ia",["1"]) ("ia",["0x999"]) ("ia",["1"]) -("tp",["((SourceText \"0x1\",SourceText \"0x2\"),(SourceText \"0x3\",SourceText \"0x4\"))"]) ===================================== testsuite/tests/ghc-api/annotations/Test10313.hs ===================================== @@ -33,5 +33,3 @@ strictStream (Bitstream l v) Exact l b = {-# SCC "foo\x64" #-} 006 - -c = {-# GENERATED "foob\x61r" 1 : 2 - 3 : 4 #-} 0.00 ===================================== testsuite/tests/ghc-api/annotations/Test11430.hs ===================================== @@ -21,5 +21,3 @@ x = undefined {-# INLINABLE [1] y #-} y :: (Num a, Integral b) => a -> b -> a y = undefined - -c = {-# GENERATED "foob\x61r" 0x1 : 0x2 - 0x3 : 0x4 #-} 0.00 ===================================== testsuite/tests/ghc-api/annotations/stringSource.hs ===================================== @@ -86,7 +86,6 @@ testOneFile libdir fileName = do doPragE :: HsPragE GhcPs -> [(String,[Located (SourceText,FastString)])] doPragE (HsPragSCC _ src ss) = [("sc",[conv (noLoc ss)])] - doPragE (HsPragTick _ src (ss,_,_) _ss2) = [("tp",[conv (noLoc ss)])] conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs) ===================================== testsuite/tests/ghc-api/annotations/t11430.hs ===================================== @@ -68,7 +68,6 @@ testOneFile libdir fileName = do doRuleDecl (HsRule _ _ _ _ _ _ _) = [] doHsExpr :: HsExpr GhcPs -> [(String,[String])] - doHsExpr (HsPragE _ (HsPragTick _ src (_,_,_) ss) _) = [("tp",[show ss])] doHsExpr _ = [] doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _) ===================================== testsuite/tests/printer/Makefile ===================================== @@ -190,10 +190,6 @@ ppr045: ppr046: $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr046.hs -.PHONY: ppr047 -ppr047: - $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr047.hs - .PHONY: ppr048 ppr048: $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr048.hs ===================================== testsuite/tests/printer/Ppr047.hs deleted ===================================== @@ -1,3 +0,0 @@ -module ExprPragmas where - -c = {-# GENERATED "foobar" 1 : 2 - 3 : 4 #-} 0.00 ===================================== testsuite/tests/printer/all.T ===================================== @@ -44,7 +44,6 @@ test('Ppr043', [ignore_stderr, req_interp], makefile_test, ['ppr043']) test('Ppr044', ignore_stderr, makefile_test, ['ppr044']) test('Ppr045', ignore_stderr, makefile_test, ['ppr045']) test('Ppr046', ignore_stderr, makefile_test, ['ppr046']) -test('Ppr047', ignore_stderr, makefile_test, ['ppr047']) test('Ppr048', ignore_stderr, makefile_test, ['ppr048']) test('T13199', [ignore_stderr, req_interp], makefile_test, ['T13199']) test('T13050p', ignore_stderr, makefile_test, ['T13050p']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 54468d1e60cb10093120137766cfc9dd91671c98 +Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28c79894b4e2d2616815f916f46fe26f389012da -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/28c79894b4e2d2616815f916f46fe26f389012da You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 18:25:59 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 08 Sep 2020 14:25:59 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18649 Message-ID: <5f57ccb7cea1e_80b3f8472cd72fc1109344e@gitlab.haskell.org.mail> Simon Peyton Jones pushed new branch wip/T18649 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18649 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 18:27:25 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Tue, 08 Sep 2020 14:27:25 -0400 Subject: [Git][ghc/ghc][wip/T18649] WIP on T18649 Message-ID: <5f57cd0d320ce_80b3f8447410dc4110936d5@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18649 at Glasgow Haskell Compiler / GHC Commits: 973a0c82 by Simon Peyton Jones at 2020-09-08T19:26:49+01:00 WIP on T18649 Needs a proper commit messag -- to come - - - - - 12 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - + testsuite/tests/simplCore/should_compile/T18649.hs - + testsuite/tests/simplCore/should_compile/T18649.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_run/T18627.hs - + testsuite/tests/typecheck/should_run/T18627.stdout - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2510,9 +2510,12 @@ mkCallUDs' env f args -- we decide on a case by case basis if we want to specialise -- on this argument; if so, SpecDict, if not UnspecArg mk_spec_arg arg (Anon InvisArg pred) - | type_determines_value (scaledThing pred) - , interestingDict env arg -- Note [Interesting dictionary arguments] + | not (isIPLikePred (scaledThing pred)) + -- See Note [Type determines value] + , interestingDict env arg + -- See Note [Interesting dictionary arguments] = SpecDict arg + | otherwise = UnspecArg mk_spec_arg _ (Anon VisArg _) @@ -2525,41 +2528,18 @@ mkCallUDs' env f args -- in specImports -- Use 'realIdUnfolding' to ignore the loop-breaker flag! - type_determines_value pred -- See Note [Type determines value] - = case classifyPredType pred of - ClassPred cls _ -> not (isIPClass cls) -- Superclasses can't be IPs - EqPred {} -> True - IrredPred {} -> True -- Things like (D []) where D is a - -- Constraint-ranged family; #7785 - ForAllPred {} -> True - -{- -Note [Type determines value] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Only specialise on non-IP *class* params, because these are the ones -whose *type* determines their *value*. In particular, with implicit -params, the type args *don't* say what the value of the implicit param -is! See #7101. +{- Note [Type determines value] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Only specialise on non-impicit-parameter *class* params, because these +are the ones whose *type* determines their *value*. In particular, +with implicit params, the type args *don't* say what the value of the +implicit param is! See #7101. So we treat implicit params just like ordinary arguments for the purposes of specialisation. Note that we still want to specialise functions with implicit params if they have *other* dicts which are class params; see #17930. -One apparent additional complexity involves type families. For -example, consider - type family D (v::*->*) :: Constraint - type instance D [] = () - f :: D v => v Char -> Int -If we see a call (f "foo"), we'll pass a "dictionary" - () |> (g :: () ~ D []) -and it's good to specialise f at this dictionary. - -So the question is: can an implicit parameter "hide inside" a -type-family constraint like (D a). Well, no. We don't allow - type instance D Maybe = ?x:Int -Hence the IrredPred case in type_determines_value. See #7785. - Note [Interesting dictionary arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Core.Predicate ( getClassPredTys, getClassPredTys_maybe, -- Implicit parameters - isIPPred, isIPPred_maybe, isIPTyCon, isIPClass, hasIPPred, + isIPLikePred, hasIPSuperClasses, isIPTyCon, isIPClass, -- Evidence variables DictId, isEvVar, isDictId @@ -39,12 +39,10 @@ import GHC.Core.Multiplicity ( scaledThing ) import GHC.Builtin.Names -import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic -import Control.Monad ( guard ) -- | A predicate in the solver. The solver tries to prove Wanted predicates -- from Given ones. @@ -170,7 +168,7 @@ isEqPredClass :: Class -> Bool isEqPredClass cls = cls `hasKey` eqTyConKey || cls `hasKey` heqTyConKey -isClassPred, isEqPred, isEqPrimPred, isIPPred :: PredType -> Bool +isClassPred, isEqPred, isEqPrimPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tyCon | isClassTyCon tyCon -> True _ -> False @@ -186,9 +184,15 @@ isEqPred ty -- True of (a ~ b) and (a ~~ b) isEqPrimPred ty = isCoVarType ty -- True of (a ~# b) (a ~R# b) -isIPPred ty = case tyConAppTyCon_maybe ty of - Just tc -> isIPTyCon tc - _ -> False +isCTupleClass :: Class -> Bool +isCTupleClass cls = isTupleTyCon (classTyCon cls) + + +{- ********************************************************************* +* * + Implicit parameters +* * +********************************************************************* -} isIPTyCon :: TyCon -> Bool isIPTyCon tc = tc `hasKey` ipClassKey @@ -197,31 +201,85 @@ isIPTyCon tc = tc `hasKey` ipClassKey isIPClass :: Class -> Bool isIPClass cls = cls `hasKey` ipClassKey -isCTupleClass :: Class -> Bool -isCTupleClass cls = isTupleTyCon (classTyCon cls) +isIPLikePred :: Type -> Bool +-- See Note [Local implicit parameters] +isIPLikePred = is_ip_like_pred initIPRecTc -isIPPred_maybe :: Type -> Maybe (FastString, Type) -isIPPred_maybe ty = - do (tc,[t1,t2]) <- splitTyConApp_maybe ty - guard (isIPTyCon tc) - x <- isStrLitTy t1 - return (x,t2) - -hasIPPred :: PredType -> Bool -hasIPPred pred - = case classifyPredType pred of - ClassPred cls tys - | isIPClass cls -> True - | isCTupleClass cls -> any hasIPPred tys - _other -> False -{- -************************************************************************ +is_ip_like_pred :: RecTcChecker -> Type -> Bool +is_ip_like_pred rec_clss ty + | Just (tc, tys) <- splitTyConApp_maybe ty + , Just rec_clss' <- if isTupleTyCon tc -- Tuples never cause recursion + then Just rec_clss + else checkRecTc rec_clss tc + , Just cls <- tyConClass_maybe tc + = isIPClass cls || has_ip_super_classes rec_clss' cls tys + + | otherwise + = False -- Includes things like (D []) where D is + -- a Constraint-ranged family; #7785 + +hasIPSuperClasses :: Class -> [Type] -> Bool +-- See Note [Local implicit parameters] +hasIPSuperClasses = has_ip_super_classes initIPRecTc + +has_ip_super_classes :: RecTcChecker -> Class -> [Type] -> Bool +has_ip_super_classes rec_clss cls tys + = any ip_ish (classSCSelIds cls) + where + -- Check that the type of a superclass determines its value + -- sc_sel_id :: forall a b. C a b -> + ip_ish sc_sel_id = is_ip_like_pred rec_clss $ + funResultTy $ + piResultTys (varType sc_sel_id) tys + + +initIPRecTc :: RecTcChecker +initIPRecTc = setRecTcMaxBound 1 initRecTc + +{- Note [Local implicit parameters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Unlike normal classes, we can have local instances for implicit parameters, +in the form of + let ?x = True in ... +So in various places we must be careful not to assume that any value +of the right type will do; we must carefully look for the innermost binding. +So isIPLikePred checks whether this is an implicit parameter, or has +a superclass that is an implicit parameter. + +We must be careful with superclasses, as #18649 showed. Haskell doesn't +allow an implicit parameter as a superclass + class (?x::a) => C a where ... +but with a constraint tuple we might have + (% Eq a, ?x::Int %) +and /its/ superclasses, namely (Eq a) and (?x::Int), /do/ include an implicit +parameter. + +With ConstraintKinds this can apply to /any/ class, e.g. + class sc => C sc where ... +Then (C (?x::Int)) has (?x::Int) as a superclass. So we must instantiate +and check each superclass, one by one, in hasIPSuperClasses. + +Another apparent additional complexity involves type families. For +example, consider + type family D (v::*->*) :: Constraint + type instance D [] = () + f :: D v => v Char -> Int +If we see a call (f "foo"), we'll pass a "dictionary" + () |> (g :: () ~ D []) +and it's good to specialise f at this dictionary. + +So the question is: can an implicit parameter "hide inside" a +type-family constraint like (D a). Well, no. We don't allow + type instance D Maybe = ?x:Int +Hence the IrredPred case in type_determines_value. See #7785. +-} + +{- ********************************************************************* * * Evidence variables * * -************************************************************************ --} +********************************************************************* -} isEvVar :: Var -> Bool isEvVar var = isEvVarType (varType var) ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1377,7 +1377,7 @@ growThetaTyVars theta tcvs | otherwise = transCloVarSet mk_next seed_tcvs where seed_tcvs = tcvs `unionVarSet` tyCoVarsOfTypes ips - (ips, non_ips) = partition isIPPred theta + (ips, non_ips) = partition isIPLikePred theta -- See Note [Inheriting implicit parameters] in GHC.Tc.Utils.TcType mk_next :: VarSet -> VarSet -- Maps current set to newly-grown ones ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -566,10 +566,10 @@ solveOneFromTheOther ev_i ev_w ev_id_w = ctEvEvId ev_w different_level_strategy -- Both Given - | isIPPred pred = if lvl_w > lvl_i then KeepWork else KeepInert - | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork + | isIPLikePred pred = if lvl_w > lvl_i then KeepWork else KeepInert + | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork -- See Note [Replacement vs keeping] (the different-level bullet) - -- For the isIPPred case see Note [Shadowing of Implicit Parameters] + -- For the isIPLikePred case see Note [Shadowing of Implicit Parameters] same_level_strategy binds -- Both Given | GivenOrigin (InstSC s_i) <- ctLocOrigin loc_i @@ -1071,6 +1071,8 @@ shortCutSolver dflags ev_w ev_i -- programs should typecheck regardless of whether we take this step or -- not. See Note [Shortcut solving] + && not (isIPLikePred (ctEvPred ev_w)) -- Not for implicit parameters (#18627) + && not (xopt LangExt.IncoherentInstances dflags) -- If IncoherentInstances is on then we cannot rely on coherence of proofs -- in order to justify this optimization: The proof provided by the @@ -1079,6 +1081,7 @@ shortCutSolver dflags ev_w ev_i && gopt Opt_SolveConstantDicts dflags -- Enabled by the -fsolve-constant-dicts flag + = do { ev_binds_var <- getTcEvBindsVar ; ev_binds <- ASSERT2( not (isCoEvBindsVar ev_binds_var ), ppr ev_w ) getTcEvBindsMap ev_binds_var ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2527,8 +2527,7 @@ emptyDictMap = emptyTcAppMap findDict :: DictMap a -> CtLoc -> Class -> [Type] -> Maybe a findDict m loc cls tys - | isCTupleClass cls - , any hasIPPred tys -- See Note [Tuples hiding implicit parameters] + | hasIPSuperClasses cls tys -- See Note [Tuples hiding implicit parameters] = Nothing | Just {} <- isCallStackPred cls tys ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -79,7 +79,7 @@ module GHC.Tc.Utils.TcType ( isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, isBoolTy, isUnitTy, isCharTy, isCallStackTy, isCallStackPred, - hasIPPred, isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, + isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, isPredTy, isTyVarClassPred, isTyVarHead, isInsolubleOccursCheck, checkValidClsArgs, hasTyVarHead, isRigidTy, isAlmostFunctionFree, @@ -141,7 +141,7 @@ module GHC.Tc.Utils.TcType ( mkTyConTy, mkTyVarTy, mkTyVarTys, mkTyCoVarTy, mkTyCoVarTys, - isClassPred, isEqPrimPred, isIPPred, isEqPred, isEqPredClass, + isClassPred, isEqPrimPred, isIPLikePred, isEqPred, isEqPredClass, mkClassPred, tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy, isRuntimeRepVar, isKindLevPoly, @@ -1747,7 +1747,7 @@ pickCapturedPreds pickCapturedPreds qtvs theta = filter captured theta where - captured pred = isIPPred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) + captured pred = isIPLikePred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) -- Superclasses ===================================== testsuite/tests/simplCore/should_compile/T18649.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} + +module Test where + +import Prelude + +type Hidden a = + ( ?enable :: a + , Eq a -- removing this "fixes" the issue + ) + +{-# NOINLINE a #-} +a :: Hidden Bool => Integer -> Bool +a _ = ?enable + +system :: Hidden Bool => Bool +system = a 0 + +topEntity :: Bool -> Bool +topEntity ena = let ?enable = ena + in system + +someVar = let ?enable = True + in system ===================================== testsuite/tests/simplCore/should_compile/T18649.stderr ===================================== @@ -0,0 +1,4 @@ + +==================== Tidy Core rules ==================== + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -333,3 +333,7 @@ test('T18347', normal, compile, ['-dcore-lint -O']) test('T18355', [ grep_errmsg(r'OneShot') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T18399', normal, compile, ['-dcore-lint -O']) test('T18589', normal, compile, ['-dcore-lint -O']) + +# T18648 should /not/ generate a specialisation rule +test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) + ===================================== testsuite/tests/typecheck/should_run/T18627.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Main where + +import GHC.Classes + +instance IP "x" Int where + ip = 21 + +baz :: (?x :: Int) => Int +baz = ?x + +main :: IO () +main = let ?x = 42 + in print baz ===================================== testsuite/tests/typecheck/should_run/T18627.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -146,3 +146,4 @@ test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, ['']) test('UnliftedNewtypesIdentityRun', normal, compile_and_run, ['']) test('UnliftedNewtypesCoerceRun', normal, compile_and_run, ['']) test('T17104', normal, compile_and_run, ['']) +test('T18627', normal, compile_and_run, ['-O']) # Optimisation shows up the bug View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/973a0c829a364896be0d7121e5e8183b3b15e863 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/973a0c829a364896be0d7121e5e8183b3b15e863 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 19:42:08 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Sep 2020 15:42:08 -0400 Subject: [Git][ghc/ghc][master] rts: Add stg_copyArray_barrier to RtsSymbols list Message-ID: <5f57de904a4fd_80bd8172cc11096846@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - 1 changed file: - rts/RtsSymbols.c Changes: ===================================== rts/RtsSymbols.c ===================================== @@ -710,6 +710,7 @@ SymI_HasProto(stg_copySmallArrayzh) \ SymI_HasProto(stg_copySmallMutableArrayzh) \ SymI_HasProto(stg_casSmallArrayzh) \ + SymI_HasProto(stg_copyArray_barrier) \ SymI_HasProto(stg_newBCOzh) \ SymI_HasProto(stg_newByteArrayzh) \ SymI_HasProto(stg_casIntArrayzh) \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea1cbb8f2ac9e077ed19530911c3a35c5f46ee8a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea1cbb8f2ac9e077ed19530911c3a35c5f46ee8a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 19:42:48 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Sep 2020 15:42:48 -0400 Subject: [Git][ghc/ghc][master] testsuite: Output performance test results in tabular format Message-ID: <5f57deb8cc095_80b3f849a4d50e0111022b5@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 3 changed files: - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - testsuite/driver/testutil.py Changes: ===================================== testsuite/driver/perf_notes.py ===================================== @@ -22,7 +22,7 @@ import sys from collections import namedtuple from math import ceil, trunc -from testutil import passed, failBecause, testing_metrics +from testutil import passed, failBecause, testing_metrics, print_table from term_color import Color, colored from my_typing import * @@ -45,6 +45,14 @@ def inside_git_repo() -> bool: def is_worktree_dirty() -> bool: return subprocess.check_output(['git', 'status', '--porcelain']) != b'' +# Get length of abbreviated git commit hash +def get_abbrev_hash_length() -> int: + try: + return len(subprocess.check_output(['git', 'rev-parse', + '--short', 'HEAD']).strip()) + except subprocess.CalledProcessError: + return 10 + # # Some data access functions. At the moment this uses git notes. # @@ -100,6 +108,15 @@ class MetricChange(Enum): } return strings[self] + def short_name(self): + strings = { + MetricChange.NewMetric: "new", + MetricChange.NoChange: "unch", + MetricChange.Increase: "incr", + MetricChange.Decrease: "decr" + } + return strings[self] + AllowedPerfChange = NamedTuple('AllowedPerfChange', [('direction', MetricChange), ('metrics', List[str]), @@ -758,7 +775,7 @@ def main() -> None: exit(0) # - # String utilities for pretty-printing + # Print the data in tablular format # # T1234 T1234 @@ -770,11 +787,12 @@ def main() -> None: # HEAD~1 10023 10023 # HEAD~2 21234 21234 # HEAD~3 20000 20000 - - # Data is already in colum major format, so do that, calculate column widths - # then transpose and print each row. def strMetric(x): return '{:.2f}'.format(x.value) if x != None else "" + # Data is in colum major format, so transpose and pass to print_table. + T = TypeVar('T') + def transpose(xss: List[List[T]]) -> List[List[T]]: + return list(map(list, zip(*xss))) headerCols = [ ["","","","Commit"] ] \ + [ [name, metric, way, env] for (env, name, metric, way) in testSeries ] @@ -782,17 +800,7 @@ def main() -> None: + [ [strMetric(get_commit_metric(ref, commit, env, name, metric, way)) \ for commit in commits ] \ for (env, name, metric, way) in testSeries ] - colWidths = [max([2+len(cell) for cell in colH + colD]) for (colH,colD) in zip(headerCols, dataCols)] - col_fmts = ['{:>' + str(w) + '}' for w in colWidths] - - def printCols(cols): - for row in zip(*cols): - # print(list(zip(col_fmts, row))) - print(''.join([f.format(cell) for (f,cell) in zip(col_fmts, row)])) - - printCols(headerCols) - print('-'*(sum(colWidths)+2)) - printCols(dataCols) + print_table(transpose(headerCols), transpose(dataCols)) if __name__ == '__main__': main() ===================================== testsuite/driver/runtests.py ===================================== @@ -23,11 +23,11 @@ import traceback # So we import it here first, so that the testsuite doesn't appear to fail. import subprocess -from testutil import getStdout, Watcher, str_warn, str_info +from testutil import getStdout, Watcher, str_warn, str_info, print_table, shorten_metric_name from testglobals import getConfig, ghc_env, getTestRun, TestConfig, \ TestOptions, brokens, PerfMetric from my_typing import TestName -from perf_notes import MetricChange, GitRef, inside_git_repo, is_worktree_dirty, format_perf_stat +from perf_notes import MetricChange, GitRef, inside_git_repo, is_worktree_dirty, format_perf_stat, get_abbrev_hash_length, is_commit_hash from junit import junit import term_color from term_color import Color, colored @@ -341,23 +341,52 @@ def cleanup_and_exit(exitcode): exit(exitcode) def tabulate_metrics(metrics: List[PerfMetric]) -> None: - for metric in sorted(metrics, key=lambda m: (m.stat.test, m.stat.way, m.stat.metric)): - print("{test:24} {metric:40} {value:15.3f}".format( - test = "{}({})".format(metric.stat.test, metric.stat.way), - metric = metric.stat.metric, - value = metric.stat.value - )) - if metric.baseline is not None: - val0 = metric.baseline.perfStat.value - val1 = metric.stat.value - rel = 100 * (val1 - val0) / val0 - print("{space:24} {herald:40} {value:15.3f} [{direction}, {rel:2.1f}%]".format( - space = "", - herald = "(baseline @ {commit})".format( - commit = metric.baseline.commit), - value = val0, - direction = metric.change, - rel = rel + abbrevLen = get_abbrev_hash_length() + hasBaseline = any([x.baseline is not None for x in metrics]) + baselineCommitSet = set([x.baseline.commit for x in metrics if x.baseline is not None]) + hideBaselineCommit = not hasBaseline or len(baselineCommitSet) == 1 + hideBaselineEnv = not hasBaseline or all( + [x.stat.test_env == x.baseline.perfStat.test_env + for x in metrics if x.baseline is not None]) + def row(cells: Tuple[str, str, str, str, str, str, str]) -> List[str]: + return [x for (idx, x) in enumerate(list(cells)) if + (idx != 2 or not hideBaselineCommit) and + (idx != 3 or not hideBaselineEnv )] + + headerRows = [ + row(("", "", "Baseline", "Baseline", "Baseline", "", "")), + row(("Test", "Metric", "commit", "environment", "value", "New value", "Change")) + ] + def strDiff(x: PerfMetric) -> str: + if x.baseline is None: + return "" + val0 = x.baseline.perfStat.value + val1 = x.stat.value + return "{}({:+2.1f}%)".format(x.change.short_name(), 100 * (val1 - val0) / val0) + dataRows = [row(( + "{}({})".format(x.stat.test, x.stat.way), + shorten_metric_name(x.stat.metric), + "{}".format(x.baseline.commit[:abbrevLen] + if is_commit_hash(x.baseline.commit) else x.baseline.commit) + if x.baseline is not None else "", + "{}".format(x.baseline.perfStat.test_env) + if x.baseline is not None else "", + "{:13.1f}".format(x.baseline.perfStat.value) + if x.baseline is not None else "", + "{:13.1f}".format(x.stat.value), + strDiff(x) + )) for x in sorted(metrics, key = + lambda m: (m.stat.test, m.stat.way, m.stat.metric))] + print_table(headerRows, dataRows, 1) + print("") + if hasBaseline: + if hideBaselineEnv: + print("* All baselines were measured in the same environment as this test run") + if hideBaselineCommit: + commit = next(iter(baselineCommitSet)) + print("* All baseline commits are {}".format( + commit[:abbrevLen] + if is_commit_hash(commit) else commit )) # First collect all the tests to be run ===================================== testsuite/driver/testutil.py ===================================== @@ -144,3 +144,29 @@ def memoize(f): cached._cache = None return cached + +# Print the matrix data in a tabular format. +def print_table(header_rows: List[List[str]], data_rows: List[List[str]], padding=2) -> None: + # Calculate column widths then print each row. + colWidths = [(0 if idx == 0 else padding) + max([len(cell) for cell in col]) + for (idx, col) in enumerate(zip(*(header_rows + data_rows)))] + col_fmts = ['{:>' + str(w) + '}' for w in colWidths] + + def printCols(cols): + for row in cols: + print(''.join([f.format(cell) for (f,cell) in zip(col_fmts, row)])) + + printCols(header_rows) + print('-' * sum(colWidths)) + printCols(data_rows) + +def shorten_metric_name(name: str) -> str: + dic = { + "runtime/bytes allocated": "run/alloc", + "runtime/peak_megabytes_allocated": "run/peak", + "runtime/max_bytes_used": "run/max", + "compile_time/bytes allocated": "ghc/alloc", + "compile_time/peak_megabytes_allocated": "ghc/peak", + "compile_time/max_bytes_used": "ghc/max", + } + return dic.get(name, name) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7b2f799469a969ad7a2535be57f105186946c40 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d7b2f799469a969ad7a2535be57f105186946c40 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 19:43:27 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Sep 2020 15:43:27 -0400 Subject: [Git][ghc/ghc][master] Make the forall-or-nothing rule only apply to invisible foralls (#18660) Message-ID: <5f57dedfdca45_80b3f8429a596f4111061f8@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 5 changed files: - compiler/GHC/Hs/Type.hs - compiler/GHC/Rename/HsType.hs - docs/users_guide/exts/explicit_forall.rst - + testsuite/tests/dependent/should_compile/T18660.hs - testsuite/tests/dependent/should_compile/all.T Changes: ===================================== compiler/GHC/Hs/Type.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Hs.Type ( mkEmptyImplicitBndrs, mkEmptyWildCardBndrs, mkHsForAllVisTele, mkHsForAllInvisTele, mkHsQTvs, hsQTvExplicit, emptyLHsQTvs, - isHsKindedTyVar, hsTvbAllKinded, isLHsForAllTy, + isHsKindedTyVar, hsTvbAllKinded, isLHsInvisForAllTy, hsScopedTvs, hsWcScopedTvs, dropWildCards, hsTyVarName, hsAllLTyVarNames, hsLTyVarLocNames, hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsExplicitLTyVarNames, @@ -1278,9 +1278,12 @@ ignoreParens :: LHsType (GhcPass p) -> LHsType (GhcPass p) ignoreParens (L _ (HsParTy _ ty)) = ignoreParens ty ignoreParens ty = ty -isLHsForAllTy :: LHsType (GhcPass p) -> Bool -isLHsForAllTy (L _ (HsForAllTy {})) = True -isLHsForAllTy _ = False +-- | Is this type headed by an invisible @forall@? This is used to determine +-- if the type variables in a type should be implicitly quantified. +-- See @Note [forall-or-nothing rule]@ in "GHC.Rename.HsType". +isLHsInvisForAllTy :: LHsType (GhcPass p) -> Bool +isLHsInvisForAllTy (L _ (HsForAllTy{hst_tele = HsForAllInvis{}})) = True +isLHsInvisForAllTy _ = False {- ************************************************************************ ===================================== compiler/GHC/Rename/HsType.hs ===================================== @@ -168,7 +168,7 @@ rn_hs_sig_wc_type scoping ctxt hs_ty thing_inside ; let nwc_rdrs = nubL nwc_rdrs' ; implicit_bndrs <- case scoping of AlwaysBind -> pure tv_rdrs - BindUnlessForall -> forAllOrNothing (isLHsForAllTy hs_ty) tv_rdrs + BindUnlessForall -> forAllOrNothing (isLHsInvisForAllTy hs_ty) tv_rdrs NeverBind -> pure [] ; rnImplicitBndrs Nothing implicit_bndrs $ \ vars -> do { (wcs, hs_ty', fvs1) <- rnWcBody ctxt nwc_rdrs hs_ty @@ -321,7 +321,7 @@ rnHsSigType :: HsDocContext rnHsSigType ctx level (HsIB { hsib_body = hs_ty }) = do { traceRn "rnHsSigType" (ppr hs_ty) ; rdr_env <- getLocalRdrEnv - ; vars0 <- forAllOrNothing (isLHsForAllTy hs_ty) + ; vars0 <- forAllOrNothing (isLHsInvisForAllTy hs_ty) $ filterInScope rdr_env $ extractHsTyRdrTyVars hs_ty ; rnImplicitBndrs Nothing vars0 $ \ vars -> @@ -331,17 +331,43 @@ rnHsSigType ctx level (HsIB { hsib_body = hs_ty }) , hsib_body = body' } , fvs ) } } --- Note [forall-or-nothing rule] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Free variables in signatures are usually bound in an implicit --- 'forall' at the beginning of user-written signatures. However, if the --- signature has an explicit forall at the beginning, this is disabled. --- --- The idea is nested foralls express something which is only --- expressible explicitly, while a top level forall could (usually) be --- replaced with an implicit binding. Top-level foralls alone ("forall.") are --- therefore an indication that the user is trying to be fastidious, so --- we don't implicitly bind any variables. +{- +Note [forall-or-nothing rule] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Free variables in signatures are usually bound in an implicit 'forall' at the +beginning of user-written signatures. However, if the signature has an +explicit, invisible forall at the beginning, this is disabled. + +The idea is nested foralls express something which is only expressible +explicitly, while a top level forall could (usually) be replaced with an +implicit binding. Top-level foralls alone ("forall.") are therefore an +indication that the user is trying to be fastidious, so we don't implicitly +bind any variables. + +Note that this rule only applies to outermost /in/visible 'forall's, and not +outermost visible 'forall's. See #18660 for more on this point. + +Here are some concrete examples to demonstrate the forall-or-nothing rule in +action: + + type F1 :: a -> b -> b -- Legal; a,b are implicitly quantified. + -- Equivalently: forall a b. a -> b -> b + + type F2 :: forall a b. a -> b -> b -- Legal; explicitly quantified + + type F3 :: forall a. a -> b -> b -- Illegal; the forall-or-nothing rule says that + -- if you quantify a, you must also quantify b + + type F4 :: forall a -> b -> b -- Legal; the top quantifier (forall a) is a /visible/ + -- quantifer, so the "nothing" part of the forall-or-nothing + -- rule applies, and b is therefore implicitly quantified. + -- Equivalently: forall b. forall a -> b -> b + + type F5 :: forall b. forall a -> b -> c -- Illegal; the forall-or-nothing rule says that + -- if you quantify b, you must also quantify c + + type F6 :: forall a -> forall b. b -> c -- Legal: just like F4. +-} -- | See @Note [forall-or-nothing rule]@. This tiny little function is used -- (rather than its small body inlined) to indicate that we are implementing ===================================== docs/users_guide/exts/explicit_forall.rst ===================================== @@ -56,30 +56,32 @@ The ``forall``-or-nothing rule ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In certain forms of types, type variables obey what is known as the -"``forall``-or-nothing" rule: if a type has an outermost, explicit -``forall``, then all of the type variables in the type must be explicitly -quantified. These two examples illustrate how the rule works: :: +"``forall``-or-nothing" rule: if a type has an outermost, explicit, +invisible ``forall``, then all of the type variables in the type must be +explicitly quantified. These two examples illustrate how the rule works: :: f :: forall a b. a -> b -> b -- OK, `a` and `b` are explicitly bound g :: forall a. a -> forall b. b -> b -- OK, `a` and `b` are explicitly bound h :: forall a. a -> b -> b -- Rejected, `b` is not in scope The type signatures for ``f``, ``g``, and ``h`` all begin with an outermost -``forall``, so every type variable in these signatures must be explicitly -bound by a ``forall``. Both ``f`` and ``g`` obey the ``forall``-or-nothing -rule, since they explicitly quantify ``a`` and ``b``. On the other hand, -``h`` does not explicitly quantify ``b``, so GHC will reject its type -signature for being improperly scoped. +invisible ``forall``, so every type variable in these signatures must be +explicitly bound by a ``forall``. Both ``f`` and ``g`` obey the +``forall``-or-nothing rule, since they explicitly quantify ``a`` and ``b``. On +the other hand, ``h`` does not explicitly quantify ``b``, so GHC will reject +its type signature for being improperly scoped. In places where the ``forall``-or-nothing rule takes effect, if a type does -*not* have an outermost ``forall``, then any type variables that are not -explicitly bound by a ``forall`` become implicitly quantified. For example: :: +*not* have an outermost invisible ``forall``, then any type variables that are +not explicitly bound by a ``forall`` become implicitly quantified. For example: :: i :: a -> b -> b -- `a` and `b` are implicitly quantified j :: a -> forall b. b -> b -- `a` is implicitly quantified k :: (forall a. a -> b -> b) -- `b` is implicitly quantified + type L :: forall a -> b -> b -- `b` is implicitly quantified -GHC will accept ``i``, ``j``, and ``k``'s type signatures. Note that: +GHC will accept ``i``, ``j``, and ``k``'s type signatures, as well as ``L``'s +kind signature. Note that: - ``j``'s signature is accepted despite its mixture of implicit and explicit quantification. As long as a ``forall`` is not an outermost one, it is fine @@ -88,6 +90,9 @@ GHC will accept ``i``, ``j``, and ``k``'s type signatures. Note that: the ``forall`` is not an outermost ``forall``. The ``forall``-or-nothing rule is one of the few places in GHC where the presence or absence of parentheses can be semantically significant! +- ``L``'s signature begins with an outermost ``forall``, but it is a *visible* + ``forall``, not an invisible ``forall``, and therefore does not trigger the + ``forall``-or-nothing rule. The ``forall``-or-nothing rule takes effect in the following places: ===================================== testsuite/tests/dependent/should_compile/T18660.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} +module T18660 where + +type F :: forall a -> b -> b +type F x y = y ===================================== testsuite/tests/dependent/should_compile/all.T ===================================== @@ -66,3 +66,4 @@ test('T16326_Compile2', normal, compile, ['']) test('T16391a', normal, compile, ['']) test('T16344b', normal, compile, ['']) test('T16347', normal, compile, ['']) +test('T18660', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44472daf500bf862921e89ad45c9741a07a64f61 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/44472daf500bf862921e89ad45c9741a07a64f61 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 19:44:05 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Sep 2020 15:44:05 -0400 Subject: [Git][ghc/ghc][master] 2 commits: gitlab-ci: Handle distributions without locales Message-ID: <5f57df05e483d_80bd8172cc111086e@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - 1 changed file: - .gitlab/ci.sh Changes: ===================================== .gitlab/ci.sh ===================================== @@ -58,6 +58,12 @@ function run() { TOP="$(pwd)" function setup_locale() { + # Musl doesn't provide locale support at all... + if ! which locale > /dev/null; then + info "No locale executable. Skipping locale setup..." + return + fi + # BSD grep terminates early with -q, consequently locale -a will get a # SIGPIPE and the pipeline will fail with pipefail. shopt -o -u pipefail @@ -70,6 +76,9 @@ function setup_locale() { elif locale -a | grep -q en_US.UTF-8; then # Centos doesn't have C.UTF-8 export LANG=en_US.UTF-8 + elif locale -a | grep -q en_US.utf8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.utf8 else error "Failed to find usable locale" info "Available locales:" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44472daf500bf862921e89ad45c9741a07a64f61...d989c84225090f850591e9f4f82adffbf8c96cac -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/44472daf500bf862921e89ad45c9741a07a64f61...d989c84225090f850591e9f4f82adffbf8c96cac You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 19:53:48 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Sep 2020 15:53:48 -0400 Subject: [Git][ghc/ghc][ghc-9.0] 3 commits: gitlab-ci: Accept Centos 7 C.utf8 locale Message-ID: <5f57e14c26944_80b3f847c1e6528111113b7@gitlab.haskell.org.mail> Ben Gamari pushed to branch ghc-9.0 at Glasgow Haskell Compiler / GHC Commits: 214b2b69 by Ben Gamari at 2020-09-07T20:28:21-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) (cherry picked from commit 9374737005c9fa36a870111f100fe27f9a0efd8e) - - - - - b093074e by Ben Gamari at 2020-09-07T20:28:26-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) (cherry picked from commit c10ff55fddf8c6708d679e91f3253dc642b91565) - - - - - 3e55edd9 by Ben Gamari at 2020-09-08T09:46:42-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. (cherry picked from commit 15dca84793d5ec4ff922726477923e40caa075eb) - - - - - 2 changed files: - .gitlab-ci.yml - .gitlab/ci.sh Changes: ===================================== .gitlab-ci.yml ===================================== @@ -66,7 +66,7 @@ workflow: when: always expire_in: 1 year rules: - - if: '$RELEASE == "yes"' + - if: '$RELEASE_JOB == "yes"' ############################################################ # Runner Tags ===================================== .gitlab/ci.sh ===================================== @@ -58,6 +58,12 @@ function run() { TOP="$(pwd)" function setup_locale() { + # Musl doesn't provide locale support at all... + if ! which locale > /dev/null; then + info "No locale executable. Skipping locale setup..." + return + fi + # BSD grep terminates early with -q, consequently locale -a will get a # SIGPIPE and the pipeline will fail with pipefail. shopt -o -u pipefail @@ -70,6 +76,9 @@ function setup_locale() { elif locale -a | grep -q en_US.UTF-8; then # Centos doesn't have C.UTF-8 export LANG=en_US.UTF-8 + elif locale -a | grep -q en_US.utf8; then + # Centos doesn't have C.UTF-8 + export LANG=en_US.utf8 else error "Failed to find usable locale" info "Available locales:" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c23275f4dd8999c673da1b9458c68e768e1f72a6...3e55edd97c8eba271f5cb64b9362796791e0e887 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c23275f4dd8999c673da1b9458c68e768e1f72a6...3e55edd97c8eba271f5cb64b9362796791e0e887 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 19:53:55 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Tue, 08 Sep 2020 15:53:55 -0400 Subject: [Git][ghc/ghc] Deleted branch wip/backports2 Message-ID: <5f57e1537d9f_80b3f848a29be381111157@gitlab.haskell.org.mail> Ben Gamari deleted branch wip/backports2 at Glasgow Haskell Compiler / GHC -- You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 21:25:22 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Tue, 08 Sep 2020 17:25:22 -0400 Subject: [Git][ghc/ghc][wip/T18599] Improve location handling Message-ID: <5f57f6c2a7eae_80b3f848b8dddb81111468d@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: c4cc6282 by Shayne Fletcher at 2020-09-08T17:25:00-04:00 Improve location handling - - - - - 2 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -3256,7 +3256,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp {do $5 <- unECP $5 - fmap Pbind $ mkHsFieldUpdaterPV ($1 : reverse $3) $5 + fmap Pbind $ mkHsFieldUpdaterPV (comb2 $1 $5) ($1 : reverse $3) $5 } -- See Note [Whitespace-sensitive operator parsing] in Lexer.x @@ -3265,13 +3265,13 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } let top = $1 fields = top : reverse $3 final = last fields - (l, fieldName) = (getLoc final, unLoc final) + l = comb2 top final puns <- getBit RecordPunsBit when (not puns) $ - addError (comb2 top final) $ + addError l $ text "For this to work, enable NamedFieldPuns." - var <- mkHsVarPV (L l (mkRdrUnqual . mkVarOcc . unpackFS $ fieldName)) - fmap Pbind $ mkHsFieldUpdaterPV fields var + var <- mkHsVarPV (noLoc (mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final)) + fmap Pbind $ mkHsFieldUpdaterPV l fields var } fieldToUpdate :: { [Located FastString] } ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -19,7 +19,7 @@ {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} module GHC.Parser.PostProcess ( - mkApp, mkGet, mkVar, mkFieldUpdater, mkProj, isGet, applyFieldUpdates, Fbind(..), fbindToRecField, -- RecordDot + mkApp, mkGet, mkVar, mkFieldUpdater, mkProj, isGet, applyFieldUpdates, Fbind(..), -- RecordDot mkHsOpApp, mkHsIntegral, mkHsFractional, mkHsIsString, mkHsDo, mkSpliceDecl, @@ -1393,7 +1393,7 @@ class b ~ (Body b) GhcPs => DisambECP b where -- | Return an expression without ambiguity, or fail in a non-expression context. ecpFromExp' :: LHsExpr GhcPs -> PV (Located b) -- | This can only be satified by expressions. - mkHsFieldUpdaterPV :: [Located FastString] -> Located b -> PV (Located b -> Located b) + mkHsFieldUpdaterPV :: SrcSpan -> [Located FastString] -> Located b -> PV (Located b -> Located b) -- | Disambiguate "\... -> ..." (lambda) mkHsLamPV :: SrcSpan -> MatchGroup GhcPs (Located b) -> PV (Located b) -- | Disambiguate "let ... in ..." @@ -1521,9 +1521,9 @@ instance DisambECP (HsCmd GhcPs) where type Body (HsCmd GhcPs) = HsCmd ecpFromCmd' = return ecpFromExp' (L l e) = cmdFail l (ppr e) - mkHsFieldUpdaterPV _ _ = - cmdFail (noSrcSpan) $ - text "Trying to make a field update in a command context" + mkHsFieldUpdaterPV l _ _ = + cmdFail l $ + text "Field update syntax is not supported in commands." mkHsLamPV l mg = return $ L l (HsCmdLam noExtField mg) mkHsLetPV l bs e = return $ L l (HsCmdLet noExtField bs e) type InfixOp (HsCmd GhcPs) = HsExpr GhcPs @@ -1587,7 +1587,7 @@ instance DisambECP (HsExpr GhcPs) where nest 2 (ppr c) ] return (L l hsHoleExpr) ecpFromExp' = return - mkHsFieldUpdaterPV fields arg = return $ mkFieldUpdater fields arg + mkHsFieldUpdaterPV _ fields arg = return $ mkFieldUpdater fields arg mkHsLamPV l mg = return $ L l (HsLam noExtField mg) mkHsLetPV l bs c = return $ L l (HsLet noExtField bs c) type InfixOp (HsExpr GhcPs) = HsExpr GhcPs @@ -1675,9 +1675,9 @@ instance DisambECP (PatBuilder GhcPs) where ecpFromExp' (L l e) = addFatalError l $ text "Expression syntax in pattern:" <+> ppr e - mkHsFieldUpdaterPV _ _ = - addFatalError noSrcSpan $ - text "Trying to make a field update in a pattern context" + mkHsFieldUpdaterPV l _ _ = + addFatalError l $ + text "Field update syntax is not supported in patterns." mkHsLamPV l _ = addFatalError l $ text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4cc62822e903ebbc1b2c582fa31d2abe315b7b7 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c4cc62822e903ebbc1b2c582fa31d2abe315b7b7 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 22:45:35 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Tue, 08 Sep 2020 18:45:35 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] Fix up after rebasing to bring in XRec Message-ID: <5f58098f22cd3_80b3f8438db6fb811116272@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: 078f413e by Alan Zimmerman at 2020-09-08T23:45:18+01:00 Fix up after rebasing to bring in XRec Main thing is to make type instance XRec (GhcPass p) a = GenLocated (Anno a) a type family Anno a = b But this has massive implications. - - - - - 25 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Pat.hs-boot - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/078f413e92415d9b68c5b9a76f28e533da206eff -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/078f413e92415d9b68c5b9a76f28e533da206eff You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Tue Sep 8 23:16:05 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Tue, 08 Sep 2020 19:16:05 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: rts: Add stg_copyArray_barrier to RtsSymbols list Message-ID: <5f5810b5e3a4b_80b3f8494d1b1c41112441a@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - 4594c61c by John Ericson at 2020-09-08T19:15:58-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - c862c673 by Ryan Scott at 2020-09-08T19:15:59-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 30 changed files: - .gitlab/ci.sh - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Validity.hs - compiler/GHC/Types/Literal.hs - docs/users_guide/exts/explicit_forall.rst - rts/RtsSymbols.c - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py - testsuite/driver/testutil.py - + testsuite/tests/dependent/should_compile/T18660.hs - testsuite/tests/dependent/should_compile/all.T - testsuite/tests/indexed-types/should_compile/T11361a.stderr - testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr - testsuite/tests/indexed-types/should_fail/T13971.stderr - testsuite/tests/indexed-types/should_fail/T13971b.stderr - testsuite/tests/indexed-types/should_fail/T16110_Fail2.stderr - testsuite/tests/indexed-types/should_fail/T16110_Fail3.stderr - testsuite/tests/indexed-types/should_fail/T16356_Fail1.stderr - testsuite/tests/indexed-types/should_fail/T16356_Fail2.stderr - + testsuite/tests/indexed-types/should_fail/T18648.hs - + testsuite/tests/indexed-types/should_fail/T18648.stderr - testsuite/tests/indexed-types/should_fail/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd5196ea57a5cdfa80ff943c298e05002f9ca621...c862c673eaababb1d81a6e3d4ecf8a4eefd8401d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd5196ea57a5cdfa80ff943c298e05002f9ca621...c862c673eaababb1d81a6e3d4ecf8a4eefd8401d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 01:41:27 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 08 Sep 2020 21:41:27 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] 73 commits: Initial NCG Message-ID: <5f5832c795d58_80bdb83ec41113676c@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: bf4920a8 by Moritz Angermann at 2020-09-09T09:40:44+08:00 Initial NCG - - - - - ece885c0 by Moritz Angermann at 2020-09-09T09:40:52+08:00 Address Takenobu's comments - - - - - 5369111f by Moritz Angermann at 2020-09-09T09:40:52+08:00 Fix floating points handling of NaNs - - - - - 796e2ec3 by Moritz Angermann at 2020-09-09T09:40:52+08:00 Add basic Graph Coloring support - - - - - 07e804f5 by Moritz Angermann at 2020-09-09T09:40:52+08:00 Drop debug - - - - - 41612e12 by Moritz Angermann at 2020-09-09T09:40:52+08:00 Add primops_match.cmm testsuite - - - - - b20e7822 by Moritz Angermann at 2020-09-09T09:40:53+08:00 Fix -NaN for real this time. - - - - - 62158d6f by Moritz Angermann at 2020-09-09T09:40:53+08:00 Adds nan test. - - - - - 95588cc1 by Moritz Angermann at 2020-09-09T09:40:53+08:00 no show - - - - - 93976cd4 by Moritz Angermann at 2020-09-09T09:40:53+08:00 Some notes on PIC - - - - - 92cb90de by Moritz Angermann at 2020-09-09T09:40:53+08:00 Properly load W32 with bit 31 set. - - - - - e38ca0f0 by Moritz Angermann at 2020-09-09T09:40:53+08:00 better relocation logging - - - - - 97f4a843 by Moritz Angermann at 2020-09-09T09:40:54+08:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - b2312a8a by Moritz Angermann at 2020-09-09T09:40:54+08:00 Revert "BigNum: rename BigNat types" This reverts commit d3bd68978476487591fc60f7feb7cfb36b8fc3a3. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - aa74ad98 by Moritz Angermann at 2020-09-09T09:40:54+08:00 Add AsmOpt Flags - - - - - 98a00264 by Moritz Angermann at 2020-09-09T09:40:54+08:00 Adds ANN instruction. I wish I had a `pad n` function for SDoc, that would interact with the layout, and just pad what ever was printed so far to `n` chars. - - - - - e15c3e7e by Moritz Angermann at 2020-09-09T09:40:54+08:00 Drop dead 32bit logic. - - - - - c0ae0f38 by Moritz Angermann at 2020-09-09T09:40:55+08:00 Add Show CmmExpr instances. Why would we want this, when we have Outputtable CmmExpr? Quite often when working on Code Generators, we want to structurally match on a Cmm Expression. Having to recover the Cmm Expression from its Outputtable text is not always trivial, and requires substantial effort. By having a Show instance, we can almost copy the definition to match on. - - - - - 4103bd9c by Moritz Angermann at 2020-09-09T09:40:55+08:00 Drop duplicate show instance for CLabel now. - - - - - b9fcb281 by Moritz Angermann at 2020-09-09T09:40:55+08:00 Add link, lest I keep forgetting it. - - - - - d75dd0b4 by Moritz Angermann at 2020-09-09T09:40:55+08:00 inline comments with // - - - - - 83d4a3b3 by Moritz Angermann at 2020-09-09T09:40:55+08:00 Some optimizations; not yet sure if safe or not. - - - - - 6018234c by Moritz Angermann at 2020-09-09T09:40:55+08:00 Add latest opt changes. - - - - - 54d091bb by Moritz Angermann at 2020-09-09T09:40:56+08:00 Address Takenobu Tani's comments. Thanks! - - - - - 6d083263 by Moritz Angermann at 2020-09-09T09:40:56+08:00 Fix gcd :blush: - - - - - c5bbf469 by Moritz Angermann at 2020-09-09T09:40:56+08:00 Overflow guard - - - - - c50e9e1e by Moritz Angermann at 2020-09-09T09:40:56+08:00 More annotations. - - - - - 9d85b7b6 by Moritz Angermann at 2020-09-09T09:40:56+08:00 Revert "Overflow guard" They are Integers not Ints. This reverts commit 3ef94e593a2848cf2bdc4251f5be34536642675f. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 473555a1 by Moritz Angermann at 2020-09-09T09:40:57+08:00 Add CmmAssign and CmmStore comments - - - - - b9fb33d3 by Moritz Angermann at 2020-09-09T09:40:57+08:00 Minor address mode changes - - - - - 90e45257 by Moritz Angermann at 2020-09-09T09:40:57+08:00 More Amode optimizations - - - - - cfb0699f by Moritz Angermann at 2020-09-09T09:40:57+08:00 I think this shoudl work for all Registers, not just CmmGlobal - - - - - bf3fad93 by Moritz Angermann at 2020-09-09T09:40:57+08:00 Opt <<, >> - - - - - 95e717aa by Moritz Angermann at 2020-09-09T09:40:57+08:00 Opt &&, || - - - - - f136c4b9 by Moritz Angermann at 2020-09-09T09:40:58+08:00 Add branch ANNotations. - - - - - b78d9f14 by Moritz Angermann at 2020-09-09T09:40:58+08:00 Disable Opt &&, ||, due to mask immediate - - - - - a09d9074 by Moritz Angermann at 2020-09-09T09:40:58+08:00 Opt: Adds CBZ, CBNZ - - - - - 7ab6dae5 by Moritz Angermann at 2020-09-09T09:40:58+08:00 More generic CBZ, CBNZ - - - - - 9a91fdf0 by Moritz Angermann at 2020-09-09T09:40:58+08:00 Fixup - - - - - 999fd795 by Moritz Angermann at 2020-09-09T09:40:58+08:00 very rudimentary bitmask support. - - - - - 425e9111 by Moritz Angermann at 2020-09-09T09:40:59+08:00 Add some more bitmasks - - - - - 6c1d2f5f by Moritz Angermann at 2020-09-09T09:40:59+08:00 Opt STR - - - - - b996cfe2 by Moritz Angermann at 2020-09-09T09:40:59+08:00 Fixup - - - - - 8b598d19 by Moritz Angermann at 2020-09-09T09:40:59+08:00 Fix MO_SF_Conv - - - - - a38438f7 by Moritz Angermann at 2020-09-09T09:40:59+08:00 Add Comment re MO_Memcpy - - - - - 44a1c6f0 by Moritz Angermann at 2020-09-09T09:40:59+08:00 Always PIC via GOT - - - - - c8525dd7 by Moritz Angermann at 2020-09-09T09:41:00+08:00 Fix up generated assembly. Don't generate identity moves e.g. mov x18, x18 - - - - - f0584689 by Moritz Angermann at 2020-09-09T09:41:00+08:00 Drop superfulous alignment generation. - - - - - ca93217e by Moritz Angermann at 2020-09-09T09:41:00+08:00 Hadrian :fire: - - - - - f55be89f by Moritz Angermann at 2020-09-09T09:41:00+08:00 Address Tekenobus comments. Thanks! - - - - - df5b4cdc by Moritz Angermann at 2020-09-09T09:41:00+08:00 Adds J to distinguish jumps from B. Maybe this would be better handled with a phantom type? - - - - - 8957ed57 by Moritz Angermann at 2020-09-09T09:41:01+08:00 Make sp an Operand - - - - - b74bf740 by Moritz Angermann at 2020-09-09T09:41:01+08:00 allocMoreStack This is still broken, as we can't spill into arbitrary ranges. Hence while we can allocate extra space, we can't really spill past 4096 offsets due to the immediat having to be encoded. This leaves us with a max of 512 spill slots. We *can* work around this if we change the sp though. - - - - - 58f2287f by Moritz Angermann at 2020-09-09T09:41:01+08:00 [Spill/Reload] Spill Around :fire: - - - - - bb10aff6 by Moritz Angermann at 2020-09-09T09:41:01+08:00 Address Takenobus observations! Thanks! - - - - - 447ff793 by Moritz Angermann at 2020-09-09T09:41:01+08:00 :sob: - - - - - 2e9fba1c by Moritz Angermann at 2020-09-09T09:41:01+08:00 Revert the Spill/Reload fix; undo :got: loads. This breaks dynamic, however we can build a working stage2 compiler with the following mk/build.mk BuildFlavour = quick ifneq "$(BuildFlavour)" "" include mk/flavours/$(BuildFlavour).mk endif STRIP_CMD = : DYNAMIC_BY_DEFAULT = NO DYNAMIC_GHC_PROGRAMS = NO - - - - - 49f92a85 by Moritz Angermann at 2020-09-09T09:41:02+08:00 Disable trivial deadlock detection - - - - - 1ca3f3b6 by Moritz Angermann at 2020-09-09T09:41:02+08:00 Adds some annotations - - - - - fb89c361 by Moritz Angermann at 2020-09-09T09:41:02+08:00 Trying to get PIC right. - - - - - d2e026bb by Moritz Angermann at 2020-09-09T09:41:02+08:00 [aarch64] Fix spill/reload - - - - - 9903d46e by Moritz Angermann at 2020-09-09T09:41:02+08:00 Try to get PIC right. - - - - - c801df2c by Moritz Angermann at 2020-09-09T09:41:03+08:00 Spill/Reload only need a smaller window - - - - - 354208eb by Moritz Angermann at 2020-09-09T09:41:03+08:00 Drop bad/useless optimisation This was due to not handling PIC symbols correctly and injecting CmmLoad as we do on other platforms, but this doesn't translate to aarch64's got lookups. - - - - - 14d49f1f by Moritz Angermann at 2020-09-09T09:41:03+08:00 B is b - - - - - 10b5b59d by Moritz Angermann at 2020-09-09T09:41:03+08:00 Fix CCall |Now mark used registers properly for the Register Allocator. - - - - - 7f14441c by Moritz Angermann at 2020-09-09T09:41:03+08:00 :sob: - - - - - ee7eb6fd by Moritz Angermann at 2020-09-09T09:41:03+08:00 :sob: :sob: - - - - - 11fef52e by Moritz Angermann at 2020-09-09T09:41:04+08:00 :sob: Segfault no 3. This showed up in T4114 - - - - - 759f0e0d by Moritz Angermann at 2020-09-09T09:41:04+08:00 Add mkComment to `Instruction` - - - - - 2f356679 by Moritz Angermann at 2020-09-09T09:41:04+08:00 Use mkComment for debugging - - - - - f86eff0b by Moritz Angermann at 2020-09-09T09:41:04+08:00 Fix T4114 crashes T4114 causes this codepath to show up. - - - - - 5827e725 by Moritz Angermann at 2020-09-09T09:41:04+08:00 Cleanup some compiler warnings - - - - - 10 changed files: - aclocal.m4 - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Type.hs - compiler/GHC/CmmToAsm.hs - + compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - + compiler/GHC/CmmToAsm/AArch64/Cond.hs - + compiler/GHC/CmmToAsm/AArch64/Instr.hs - + compiler/GHC/CmmToAsm/AArch64/LLVM Test Results.md The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d088f7d1af476d5bdc7cc750ce91e8f48ba222d8...5827e725749091d5c5db57464a6264a618842ee8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d088f7d1af476d5bdc7cc750ce91e8f48ba222d8...5827e725749091d5c5db57464a6264a618842ee8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 01:59:52 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Tue, 08 Sep 2020 21:59:52 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] 73 commits: Initial NCG Message-ID: <5f58371849f7d_80b110107c81113986@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: 91c9a800 by Moritz Angermann at 2020-09-09T09:58:29+08:00 Initial NCG - - - - - f044ab59 by Moritz Angermann at 2020-09-09T09:58:35+08:00 Address Takenobu's comments - - - - - 4a414b82 by Moritz Angermann at 2020-09-09T09:58:35+08:00 Fix floating points handling of NaNs - - - - - 81f61ee8 by Moritz Angermann at 2020-09-09T09:58:35+08:00 Add basic Graph Coloring support - - - - - c9296b79 by Moritz Angermann at 2020-09-09T09:58:35+08:00 Drop debug - - - - - aa003a55 by Moritz Angermann at 2020-09-09T09:58:35+08:00 Add primops_match.cmm testsuite - - - - - e9f5f2af by Moritz Angermann at 2020-09-09T09:58:35+08:00 Fix -NaN for real this time. - - - - - 4bc55702 by Moritz Angermann at 2020-09-09T09:58:36+08:00 Adds nan test. - - - - - c88ef273 by Moritz Angermann at 2020-09-09T09:58:36+08:00 no show - - - - - 5f94b5c8 by Moritz Angermann at 2020-09-09T09:58:36+08:00 Some notes on PIC - - - - - 5dbe01b9 by Moritz Angermann at 2020-09-09T09:58:36+08:00 Properly load W32 with bit 31 set. - - - - - 37389eb2 by Moritz Angermann at 2020-09-09T09:58:36+08:00 better relocation logging - - - - - e6f1e0db by Moritz Angermann at 2020-09-09T09:58:36+08:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - dff3e8d9 by Moritz Angermann at 2020-09-09T09:58:37+08:00 Revert "BigNum: rename BigNat types" This reverts commit d3bd68978476487591fc60f7feb7cfb36b8fc3a3. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - f8cb8134 by Moritz Angermann at 2020-09-09T09:58:37+08:00 Add AsmOpt Flags - - - - - 0640e8ae by Moritz Angermann at 2020-09-09T09:58:37+08:00 Adds ANN instruction. I wish I had a `pad n` function for SDoc, that would interact with the layout, and just pad what ever was printed so far to `n` chars. - - - - - 2426b591 by Moritz Angermann at 2020-09-09T09:58:37+08:00 Drop dead 32bit logic. - - - - - 5fa5c0e9 by Moritz Angermann at 2020-09-09T09:58:37+08:00 Add Show CmmExpr instances. Why would we want this, when we have Outputtable CmmExpr? Quite often when working on Code Generators, we want to structurally match on a Cmm Expression. Having to recover the Cmm Expression from its Outputtable text is not always trivial, and requires substantial effort. By having a Show instance, we can almost copy the definition to match on. - - - - - 901eae18 by Moritz Angermann at 2020-09-09T09:58:37+08:00 Drop duplicate show instance for CLabel now. - - - - - 0e89617a by Moritz Angermann at 2020-09-09T09:58:38+08:00 Add link, lest I keep forgetting it. - - - - - f49d72db by Moritz Angermann at 2020-09-09T09:58:38+08:00 inline comments with // - - - - - 4e0bf0dd by Moritz Angermann at 2020-09-09T09:58:38+08:00 Some optimizations; not yet sure if safe or not. - - - - - 78030e50 by Moritz Angermann at 2020-09-09T09:58:38+08:00 Add latest opt changes. - - - - - 113f0b69 by Moritz Angermann at 2020-09-09T09:58:38+08:00 Address Takenobu Tani's comments. Thanks! - - - - - c2737333 by Moritz Angermann at 2020-09-09T09:58:38+08:00 Fix gcd :blush: - - - - - 687fd1fc by Moritz Angermann at 2020-09-09T09:58:39+08:00 Overflow guard - - - - - 7d5e6add by Moritz Angermann at 2020-09-09T09:58:39+08:00 More annotations. - - - - - 0fe460a8 by Moritz Angermann at 2020-09-09T09:58:39+08:00 Revert "Overflow guard" They are Integers not Ints. This reverts commit 3ef94e593a2848cf2bdc4251f5be34536642675f. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 10da7b3e by Moritz Angermann at 2020-09-09T09:58:39+08:00 Add CmmAssign and CmmStore comments - - - - - 2f4a436b by Moritz Angermann at 2020-09-09T09:58:39+08:00 Minor address mode changes - - - - - fd8470a0 by Moritz Angermann at 2020-09-09T09:58:40+08:00 More Amode optimizations - - - - - 82820a0a by Moritz Angermann at 2020-09-09T09:58:40+08:00 I think this shoudl work for all Registers, not just CmmGlobal - - - - - 003ea7f4 by Moritz Angermann at 2020-09-09T09:58:40+08:00 Opt <<, >> - - - - - 3ebaafe3 by Moritz Angermann at 2020-09-09T09:58:40+08:00 Opt &&, || - - - - - b5e405a2 by Moritz Angermann at 2020-09-09T09:58:40+08:00 Add branch ANNotations. - - - - - 52d3539e by Moritz Angermann at 2020-09-09T09:58:40+08:00 Disable Opt &&, ||, due to mask immediate - - - - - 777358ef by Moritz Angermann at 2020-09-09T09:58:41+08:00 Opt: Adds CBZ, CBNZ - - - - - cbc7c586 by Moritz Angermann at 2020-09-09T09:58:41+08:00 More generic CBZ, CBNZ - - - - - fdf20590 by Moritz Angermann at 2020-09-09T09:58:41+08:00 Fixup - - - - - 99a91c35 by Moritz Angermann at 2020-09-09T09:58:41+08:00 very rudimentary bitmask support. - - - - - f7195086 by Moritz Angermann at 2020-09-09T09:58:41+08:00 Add some more bitmasks - - - - - 8e00c910 by Moritz Angermann at 2020-09-09T09:58:41+08:00 Opt STR - - - - - e393fc40 by Moritz Angermann at 2020-09-09T09:58:42+08:00 Fixup - - - - - 2e0a6d4d by Moritz Angermann at 2020-09-09T09:58:42+08:00 Fix MO_SF_Conv - - - - - c7b587f5 by Moritz Angermann at 2020-09-09T09:58:42+08:00 Add Comment re MO_Memcpy - - - - - 11c130b5 by Moritz Angermann at 2020-09-09T09:58:42+08:00 Always PIC via GOT - - - - - 60f1a153 by Moritz Angermann at 2020-09-09T09:58:42+08:00 Fix up generated assembly. Don't generate identity moves e.g. mov x18, x18 - - - - - c7359c61 by Moritz Angermann at 2020-09-09T09:58:43+08:00 Drop superfulous alignment generation. - - - - - 01b76839 by Moritz Angermann at 2020-09-09T09:58:43+08:00 Hadrian :fire: - - - - - 2758f5cd by Moritz Angermann at 2020-09-09T09:58:43+08:00 Address Tekenobus comments. Thanks! - - - - - 7e08a0ac by Moritz Angermann at 2020-09-09T09:58:43+08:00 Adds J to distinguish jumps from B. Maybe this would be better handled with a phantom type? - - - - - 5e5690d8 by Moritz Angermann at 2020-09-09T09:58:43+08:00 Make sp an Operand - - - - - 14dcaebc by Moritz Angermann at 2020-09-09T09:58:43+08:00 allocMoreStack This is still broken, as we can't spill into arbitrary ranges. Hence while we can allocate extra space, we can't really spill past 4096 offsets due to the immediat having to be encoded. This leaves us with a max of 512 spill slots. We *can* work around this if we change the sp though. - - - - - 6f983158 by Moritz Angermann at 2020-09-09T09:58:44+08:00 [Spill/Reload] Spill Around :fire: - - - - - 8e16a150 by Moritz Angermann at 2020-09-09T09:58:44+08:00 Address Takenobus observations! Thanks! - - - - - 2c0e56aa by Moritz Angermann at 2020-09-09T09:58:44+08:00 :sob: - - - - - 0eb10468 by Moritz Angermann at 2020-09-09T09:58:44+08:00 Revert the Spill/Reload fix; undo :got: loads. This breaks dynamic, however we can build a working stage2 compiler with the following mk/build.mk BuildFlavour = quick ifneq "$(BuildFlavour)" "" include mk/flavours/$(BuildFlavour).mk endif STRIP_CMD = : DYNAMIC_BY_DEFAULT = NO DYNAMIC_GHC_PROGRAMS = NO - - - - - e876348b by Moritz Angermann at 2020-09-09T09:58:44+08:00 Disable trivial deadlock detection - - - - - 58d3e2f3 by Moritz Angermann at 2020-09-09T09:58:44+08:00 Adds some annotations - - - - - f488a3d8 by Moritz Angermann at 2020-09-09T09:58:45+08:00 Trying to get PIC right. - - - - - 4dd1aaa8 by Moritz Angermann at 2020-09-09T09:58:45+08:00 [aarch64] Fix spill/reload - - - - - 331aeb2f by Moritz Angermann at 2020-09-09T09:58:45+08:00 Try to get PIC right. - - - - - 89d11d33 by Moritz Angermann at 2020-09-09T09:58:45+08:00 Spill/Reload only need a smaller window - - - - - 2eb9f10b by Moritz Angermann at 2020-09-09T09:58:45+08:00 Drop bad/useless optimisation This was due to not handling PIC symbols correctly and injecting CmmLoad as we do on other platforms, but this doesn't translate to aarch64's got lookups. - - - - - cc00541b by Moritz Angermann at 2020-09-09T09:58:45+08:00 B is b - - - - - 8ef27a9e by Moritz Angermann at 2020-09-09T09:58:46+08:00 Fix CCall |Now mark used registers properly for the Register Allocator. - - - - - a894d50f by Moritz Angermann at 2020-09-09T09:58:46+08:00 :sob: - - - - - bd0ba0fb by Moritz Angermann at 2020-09-09T09:58:46+08:00 :sob: :sob: - - - - - e6bb81d6 by Moritz Angermann at 2020-09-09T09:58:46+08:00 :sob: Segfault no 3. This showed up in T4114 - - - - - 4006c352 by Moritz Angermann at 2020-09-09T09:58:46+08:00 Add mkComment to `Instruction` - - - - - e1103e8f by Moritz Angermann at 2020-09-09T09:58:47+08:00 Use mkComment for debugging - - - - - 255a0213 by Moritz Angermann at 2020-09-09T09:58:47+08:00 Fix T4114 crashes T4114 causes this codepath to show up. - - - - - c0f42276 by Moritz Angermann at 2020-09-09T09:58:47+08:00 Cleanup some compiler warnings - - - - - 10 changed files: - aclocal.m4 - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Type.hs - compiler/GHC/CmmToAsm.hs - + compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - + compiler/GHC/CmmToAsm/AArch64/Cond.hs - + compiler/GHC/CmmToAsm/AArch64/Instr.hs - + compiler/GHC/CmmToAsm/AArch64/LLVM Test Results.md The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5827e725749091d5c5db57464a6264a618842ee8...c0f422766833fe2a4747a94897100e9c99ac0164 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5827e725749091d5c5db57464a6264a618842ee8...c0f422766833fe2a4747a94897100e9c99ac0164 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 04:46:13 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 09 Sep 2020 00:46:13 -0400 Subject: [Git][ghc/ghc][master] Use "to" instead of "2" in internal names of conversion ops Message-ID: <5f585e1576152_80b3f843a7a8a7011146172@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 4 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/Types/Literal.hs Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -603,14 +603,14 @@ primop IntLeOp "<=#" Compare Int# -> Int# -> Int# primop ChrOp "chr#" GenPrimOp Int# -> Char# with code_size = 0 -primop Int2WordOp "int2Word#" GenPrimOp Int# -> Word# +primop IntToWordOp "int2Word#" GenPrimOp Int# -> Word# with code_size = 0 -primop Int2FloatOp "int2Float#" GenPrimOp Int# -> Float# -primop Int2DoubleOp "int2Double#" GenPrimOp Int# -> Double# +primop IntToFloatOp "int2Float#" GenPrimOp Int# -> Float# +primop IntToDoubleOp "int2Double#" GenPrimOp Int# -> Double# -primop Word2FloatOp "word2Float#" GenPrimOp Word# -> Float# -primop Word2DoubleOp "word2Double#" GenPrimOp Word# -> Double# +primop WordToFloatOp "word2Float#" GenPrimOp Word# -> Float# +primop WordToDoubleOp "word2Double#" GenPrimOp Word# -> Double# primop ISllOp "uncheckedIShiftL#" GenPrimOp Int# -> Int# -> Int# {Shift left. Result undefined if shift amount is not @@ -696,7 +696,7 @@ primop SrlOp "uncheckedShiftRL#" GenPrimOp Word# -> Int# -> Word# {Shift right logical. Result undefined if shift amount is not in the range 0 to word size - 1 inclusive.} -primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int# +primop WordToIntOp "word2Int#" GenPrimOp Word# -> Int# with code_size = 0 primop WordGtOp "gtWord#" Compare Word# -> Word# -> Int# @@ -844,12 +844,12 @@ primop DoubleNegOp "negateDouble#" GenPrimOp Double# -> Double# primop DoubleFabsOp "fabsDouble#" GenPrimOp Double# -> Double# -primop Double2IntOp "double2Int#" GenPrimOp Double# -> Int# +primop DoubleToIntOp "double2Int#" GenPrimOp Double# -> Int# {Truncates a {\tt Double#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} -primop Double2FloatOp "double2Float#" GenPrimOp Double# -> Float# +primop DoubleToFloatOp "double2Float#" GenPrimOp Double# -> Float# primop DoubleExpOp "expDouble#" GenPrimOp Double# -> Double# @@ -998,7 +998,7 @@ primop FloatNegOp "negateFloat#" GenPrimOp Float# -> Float# primop FloatFabsOp "fabsFloat#" GenPrimOp Float# -> Float# -primop Float2IntOp "float2Int#" GenPrimOp Float# -> Int# +primop FloatToIntOp "float2Int#" GenPrimOp Float# -> Int# {Truncates a {\tt Float#} value to the nearest {\tt Int#}. Results are undefined if the truncation if truncation yields a value outside the range of {\tt Int#}.} @@ -1097,7 +1097,7 @@ primop FloatPowerOp "powerFloat#" GenPrimOp with code_size = { primOpCodeSizeForeignCall } -primop Float2DoubleOp "float2Double#" GenPrimOp Float# -> Double# +primop FloatToDoubleOp "float2Double#" GenPrimOp Float# -> Double# primop FloatDecode_IntOp "decodeFloat_Int#" GenPrimOp Float# -> (# Int#, Int# #) @@ -2283,11 +2283,11 @@ primop AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int# primop AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int# {Return the remainder when the {\tt Addr\#} arg, treated like an {\tt Int\#}, is divided by the {\tt Int\#} arg.} -primop Addr2IntOp "addr2Int#" GenPrimOp Addr# -> Int# +primop AddrToIntOp "addr2Int#" GenPrimOp Addr# -> Int# {Coerce directly from address to int.} with code_size = 0 deprecated_msg = { This operation is strongly deprecated. } -primop Int2AddrOp "int2Addr#" GenPrimOp Int# -> Addr# +primop IntToAddrOp "int2Addr#" GenPrimOp Int# -> Addr# {Coerce directly from int to address.} with code_size = 0 deprecated_msg = { This operation is strongly deprecated. } ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -193,10 +193,10 @@ primOpRules nm = \case SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord shiftRightLogical ] -- coercions - Word2IntOp -> mkPrimOpRule nm 1 [ liftLitPlatform word2IntLit - , inversePrimOp Int2WordOp ] - Int2WordOp -> mkPrimOpRule nm 1 [ liftLitPlatform int2WordLit - , inversePrimOp Word2IntOp ] + WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform wordToIntLit + , inversePrimOp IntToWordOp ] + IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform intToWordLit + , inversePrimOp WordToIntOp ] Narrow8IntOp -> mkPrimOpRule nm 1 [ liftLit narrow8IntLit , subsumedByPrimOp Narrow8IntOp , Narrow8IntOp `subsumesPrimOp` Narrow16IntOp @@ -229,19 +229,19 @@ primOpRules nm = \case , subsumedByPrimOp Narrow32WordOp , removeOp32 , narrowSubsumesAnd AndOp Narrow32WordOp 32 ] - OrdOp -> mkPrimOpRule nm 1 [ liftLit char2IntLit + OrdOp -> mkPrimOpRule nm 1 [ liftLit charToIntLit , inversePrimOp ChrOp ] ChrOp -> mkPrimOpRule nm 1 [ do [Lit lit] <- getArgs guard (litFitsInChar lit) - liftLit int2CharLit + liftLit intToCharLit , inversePrimOp OrdOp ] - Float2IntOp -> mkPrimOpRule nm 1 [ liftLit float2IntLit ] - Int2FloatOp -> mkPrimOpRule nm 1 [ liftLit int2FloatLit ] - Double2IntOp -> mkPrimOpRule nm 1 [ liftLit double2IntLit ] - Int2DoubleOp -> mkPrimOpRule nm 1 [ liftLit int2DoubleLit ] + FloatToIntOp -> mkPrimOpRule nm 1 [ liftLit floatToIntLit ] + IntToFloatOp -> mkPrimOpRule nm 1 [ liftLit intToFloatLit ] + DoubleToIntOp -> mkPrimOpRule nm 1 [ liftLit doubleToIntLit ] + IntToDoubleOp -> mkPrimOpRule nm 1 [ liftLit intToDoubleLit ] -- SUP: Not sure what the standard says about precision in the following 2 cases - Float2DoubleOp -> mkPrimOpRule nm 1 [ liftLit float2DoubleLit ] - Double2FloatOp -> mkPrimOpRule nm 1 [ liftLit double2FloatLit ] + FloatToDoubleOp -> mkPrimOpRule nm 1 [ liftLit floatToDoubleLit ] + DoubleToFloatOp -> mkPrimOpRule nm 1 [ liftLit doubleToFloatLit ] -- Float FloatAddOp -> mkPrimOpRule nm 2 [ binaryLit (floatOp2 (+)) @@ -1364,9 +1364,9 @@ builtinBignumRules _ = , rule_passthrough "Word# -> Integer -> Word#" integerToWordName integerFromWordName , rule_passthrough "Int64# -> Integer -> Int64#" integerToInt64Name integerFromInt64Name , rule_passthrough "Word64# -> Integer -> Word64#" integerToWord64Name integerFromWord64Name - , rule_smallIntegerTo "IS -> Word#" integerToWordName Int2WordOp - , rule_smallIntegerTo "IS -> Float" integerToFloatName Int2FloatOp - , rule_smallIntegerTo "IS -> Double" integerToDoubleName Int2DoubleOp + , rule_smallIntegerTo "IS -> Word#" integerToWordName IntToWordOp + , rule_smallIntegerTo "IS -> Float" integerToFloatName IntToFloatOp + , rule_smallIntegerTo "IS -> Double" integerToDoubleName IntToDoubleOp , rule_passthrough "Word# -> Natural -> Word#" naturalToWordName naturalNSDataConName , rule_IntegerToNaturalClamp "Integer -> Natural (clamp)" integerToNaturalClampName ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -840,9 +840,9 @@ emitPrimOp dflags primop = case primop of emitCtzCall res w (wordWidth platform) -- Unsigned int to floating point conversions - Word2FloatOp -> \[w] -> opIntoRegs $ \[res] -> do + WordToFloatOp -> \[w] -> opIntoRegs $ \[res] -> do emitPrimCall [res] (MO_UF_Conv W32) [w] - Word2DoubleOp -> \[w] -> opIntoRegs $ \[res] -> do + WordToDoubleOp -> \[w] -> opIntoRegs $ \[res] -> do emitPrimCall [res] (MO_UF_Conv W64) [w] -- Atomic operations @@ -1056,10 +1056,10 @@ emitPrimOp dflags primop = case primop of -- The rest just translate straightforwardly - Int2WordOp -> \args -> opNop args - Word2IntOp -> \args -> opNop args - Int2AddrOp -> \args -> opNop args - Addr2IntOp -> \args -> opNop args + IntToWordOp -> \args -> opNop args + WordToIntOp -> \args -> opNop args + IntToAddrOp -> \args -> opNop args + AddrToIntOp -> \args -> opNop args ChrOp -> \args -> opNop args -- Int# and Char# are rep'd the same OrdOp -> \args -> opNop args @@ -1309,14 +1309,14 @@ emitPrimOp dflags primop = case primop of -- Conversions - Int2DoubleOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W64) - Double2IntOp -> \args -> opTranslate args (MO_FS_Conv W64 (wordWidth platform)) + IntToDoubleOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W64) + DoubleToIntOp -> \args -> opTranslate args (MO_FS_Conv W64 (wordWidth platform)) - Int2FloatOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W32) - Float2IntOp -> \args -> opTranslate args (MO_FS_Conv W32 (wordWidth platform)) + IntToFloatOp -> \args -> opTranslate args (MO_SF_Conv (wordWidth platform) W32) + FloatToIntOp -> \args -> opTranslate args (MO_FS_Conv W32 (wordWidth platform)) - Float2DoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64) - Double2FloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32) + FloatToDoubleOp -> \args -> opTranslate args (MO_FF_Conv W32 W64) + DoubleToFloatOp -> \args -> opTranslate args (MO_FF_Conv W64 W32) -- Word comparisons masquerading as more exotic things. ===================================== compiler/GHC/Types/Literal.hs ===================================== @@ -39,13 +39,13 @@ module GHC.Types.Literal , litValue, isLitValue, isLitValue_maybe, mapLitValue -- ** Coercions - , word2IntLit, int2WordLit + , wordToIntLit, intToWordLit , narrowLit , narrow8IntLit, narrow16IntLit, narrow32IntLit , narrow8WordLit, narrow16WordLit, narrow32WordLit - , char2IntLit, int2CharLit - , float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit - , nullAddrLit, rubbishLit, float2DoubleLit, double2FloatLit + , charToIntLit, intToCharLit + , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit + , nullAddrLit, rubbishLit, floatToDoubleLit, doubleToFloatLit ) where #include "HsVersions.h" @@ -474,27 +474,27 @@ isLitValue = isJust . isLitValue_maybe narrow8IntLit, narrow16IntLit, narrow32IntLit, narrow8WordLit, narrow16WordLit, narrow32WordLit, - char2IntLit, int2CharLit, - float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit, - float2DoubleLit, double2FloatLit + charToIntLit, intToCharLit, + floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit, + floatToDoubleLit, doubleToFloatLit :: Literal -> Literal -word2IntLit, int2WordLit :: Platform -> Literal -> Literal -word2IntLit platform (LitNumber LitNumWord w) +wordToIntLit, intToWordLit :: Platform -> Literal -> Literal +wordToIntLit platform (LitNumber LitNumWord w) -- Map Word range [max_int+1, max_word] -- to Int range [min_int , -1] -- Range [0,max_int] has the same representation with both Int and Word | w > platformMaxInt platform = mkLitInt platform (w - platformMaxWord platform - 1) | otherwise = mkLitInt platform w -word2IntLit _ l = pprPanic "word2IntLit" (ppr l) +wordToIntLit _ l = pprPanic "wordToIntLit" (ppr l) -int2WordLit platform (LitNumber LitNumInt i) +intToWordLit platform (LitNumber LitNumInt i) -- Map Int range [min_int , -1] -- to Word range [max_int+1, max_word] -- Range [0,max_int] has the same representation with both Int and Word | i < 0 = mkLitWord platform (1 + platformMaxWord platform + i) | otherwise = mkLitWord platform i -int2WordLit _ l = pprPanic "int2WordLit" (ppr l) +intToWordLit _ l = pprPanic "intToWordLit" (ppr l) -- | Narrow a literal number (unchecked result range) narrowLit :: forall a. Integral a => Proxy a -> Literal -> Literal @@ -508,25 +508,25 @@ narrow8WordLit = narrowLit (Proxy :: Proxy Word8) narrow16WordLit = narrowLit (Proxy :: Proxy Word16) narrow32WordLit = narrowLit (Proxy :: Proxy Word32) -char2IntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c)) -char2IntLit l = pprPanic "char2IntLit" (ppr l) -int2CharLit (LitNumber _ i) = LitChar (chr (fromInteger i)) -int2CharLit l = pprPanic "int2CharLit" (ppr l) - -float2IntLit (LitFloat f) = mkLitIntUnchecked (truncate f) -float2IntLit l = pprPanic "float2IntLit" (ppr l) -int2FloatLit (LitNumber _ i) = LitFloat (fromInteger i) -int2FloatLit l = pprPanic "int2FloatLit" (ppr l) - -double2IntLit (LitDouble f) = mkLitIntUnchecked (truncate f) -double2IntLit l = pprPanic "double2IntLit" (ppr l) -int2DoubleLit (LitNumber _ i) = LitDouble (fromInteger i) -int2DoubleLit l = pprPanic "int2DoubleLit" (ppr l) - -float2DoubleLit (LitFloat f) = LitDouble f -float2DoubleLit l = pprPanic "float2DoubleLit" (ppr l) -double2FloatLit (LitDouble d) = LitFloat d -double2FloatLit l = pprPanic "double2FloatLit" (ppr l) +charToIntLit (LitChar c) = mkLitIntUnchecked (toInteger (ord c)) +charToIntLit l = pprPanic "charToIntLit" (ppr l) +intToCharLit (LitNumber _ i) = LitChar (chr (fromInteger i)) +intToCharLit l = pprPanic "intToCharLit" (ppr l) + +floatToIntLit (LitFloat f) = mkLitIntUnchecked (truncate f) +floatToIntLit l = pprPanic "floatToIntLit" (ppr l) +intToFloatLit (LitNumber _ i) = LitFloat (fromInteger i) +intToFloatLit l = pprPanic "intToFloatLit" (ppr l) + +doubleToIntLit (LitDouble f) = mkLitIntUnchecked (truncate f) +doubleToIntLit l = pprPanic "doubleToIntLit" (ppr l) +intToDoubleLit (LitNumber _ i) = LitDouble (fromInteger i) +intToDoubleLit l = pprPanic "intToDoubleLit" (ppr l) + +floatToDoubleLit (LitFloat f) = LitDouble f +floatToDoubleLit l = pprPanic "floatToDoubleLit" (ppr l) +doubleToFloatLit (LitDouble d) = LitFloat d +doubleToFloatLit l = pprPanic "doubleToFloatLit" (ppr l) nullAddrLit :: Literal nullAddrLit = LitNullAddr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5a2899ce8e06b8645946fbb67041807cd3a4fe5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e5a2899ce8e06b8645946fbb67041807cd3a4fe5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 04:46:50 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 09 Sep 2020 00:46:50 -0400 Subject: [Git][ghc/ghc][master] Postpone associated tyfam default checks until after typechecking Message-ID: <5f585e3a75d92_80b3f845984381c1115135b@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 17 changed files: - compiler/GHC/Core/Class.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/Validity.hs - testsuite/tests/indexed-types/should_compile/T11361a.stderr - testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr - testsuite/tests/indexed-types/should_fail/T13971.stderr - testsuite/tests/indexed-types/should_fail/T13971b.stderr - testsuite/tests/indexed-types/should_fail/T16110_Fail2.stderr - testsuite/tests/indexed-types/should_fail/T16110_Fail3.stderr - testsuite/tests/indexed-types/should_fail/T16356_Fail1.stderr - testsuite/tests/indexed-types/should_fail/T16356_Fail2.stderr - + testsuite/tests/indexed-types/should_fail/T18648.hs - + testsuite/tests/indexed-types/should_fail/T18648.stderr - testsuite/tests/indexed-types/should_fail/all.T - testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr Changes: ===================================== compiler/GHC/Core/Class.hs ===================================== @@ -8,7 +8,7 @@ module GHC.Core.Class ( Class, ClassOpItem, - ClassATItem(..), + ClassATItem(..), ATValidityInfo(..), ClassMinimalDef, DefMethInfo, pprDefMethInfo, @@ -97,10 +97,21 @@ type DefMethInfo = Maybe (Name, DefMethSpec Type) data ClassATItem = ATI TyCon -- See Note [Associated type tyvar names] - (Maybe (Type, SrcSpan)) + (Maybe (Type, ATValidityInfo)) -- Default associated type (if any) from this template -- Note [Associated type defaults] +-- | Information about an associated type family default implementation. This +-- is used solely for validity checking. +-- See @Note [Type-checking default assoc decls]@ in "GHC.Tc.TyCl". +data ATValidityInfo + = NoATVI -- Used for associated type families that are imported + -- from another module, for which we don't need to + -- perform any validity checking. + + | ATVI SrcSpan [Type] -- Used for locally defined associated type families. + -- The [Type] are the LHS patterns. + type ClassMinimalDef = BooleanFormula Name -- Required methods data ClassBody ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -215,7 +215,7 @@ data IfaceClassOp -- and the default method, are *not* quantified -- over the class variables -data IfaceAT = IfaceAT -- See Class.ClassATItem +data IfaceAT = IfaceAT -- See GHC.Core.Class.ClassATItem IfaceDecl -- The associated type declaration (Maybe IfaceType) -- Default associated type instance, if any ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -791,7 +791,7 @@ tc_iface_decl _parent ignore_prags Just def -> forkM (mk_at_doc tc) $ extendIfaceTyVarEnv (tyConTyVars tc) $ do { tc_def <- tcIfaceType def - ; return (Just (tc_def, noSrcSpan)) } + ; return (Just (tc_def, NoATVI)) } -- Must be done lazily in case the RHS of the defaults mention -- the type constructor being defined here -- e.g. type AT a; type AT b = AT [b] #8002 ===================================== compiler/GHC/Tc/TyCl.hs ===================================== @@ -52,7 +52,7 @@ import GHC.Core.Coercion import GHC.Tc.Types.Origin import GHC.Core.Type import GHC.Core.TyCo.Rep -- for checkValidRoles -import GHC.Core.TyCo.Ppr( pprTyVars, pprWithExplicitKindsWhen ) +import GHC.Core.TyCo.Ppr( pprTyVars ) import GHC.Core.Class import GHC.Core.Coercion.Axiom import GHC.Core.TyCon @@ -79,11 +79,9 @@ import GHC.Types.Basic import qualified GHC.LanguageExtensions as LangExt import Control.Monad -import Data.Foldable import Data.Function ( on ) import Data.Functor.Identity import Data.List -import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty ( NonEmpty(..) ) import qualified Data.Set as Set import Data.Tuple( swap ) @@ -2393,9 +2391,9 @@ tcClassATs class_name cls ats at_defs ------------------------- tcDefaultAssocDecl :: - TyCon -- ^ Family TyCon (not knot-tied) - -> [LTyFamDefltDecl GhcRn] -- ^ Defaults - -> TcM (Maybe (KnotTied Type, SrcSpan)) -- ^ Type checked RHS + TyCon -- ^ Family TyCon (not knot-tied) + -> [LTyFamDefltDecl GhcRn] -- ^ Defaults + -> TcM (Maybe (KnotTied Type, ATValidityInfo)) -- ^ Type checked RHS tcDefaultAssocDecl _ [] = return Nothing -- No default declaration @@ -2436,73 +2434,27 @@ tcDefaultAssocDecl fam_tc imp_vars (mb_expl_bndrs `orElse` []) hs_pats hs_rhs_ty - ; let fam_tvs = tyConTyVars fam_tc - ppr_eqn = ppr_default_eqn pats rhs_ty - pats_vis = tyConArgFlags fam_tc pats + ; let fam_tvs = tyConTyVars fam_tc ; traceTc "tcDefaultAssocDecl 2" (vcat - [ text "fam_tvs" <+> ppr fam_tvs + [ text "hs_pats" <+> ppr hs_pats + , text "hs_rhs_ty" <+> ppr hs_rhs_ty + , text "fam_tvs" <+> ppr fam_tvs , text "qtvs" <+> ppr qtvs - , text "pats" <+> ppr pats - , text "rhs_ty" <+> ppr rhs_ty + -- NB: Do *not* print `pats` or rhs_ty here, as they can mention + -- knot-tied TyCons. See #18648. ]) - ; cpt_tvs <- zipWithM (extract_tv ppr_eqn) pats pats_vis - ; check_all_distinct_tvs ppr_eqn $ zip cpt_tvs pats_vis - ; let subst = zipTvSubst cpt_tvs (mkTyVarTys fam_tvs) - ; pure $ Just (substTyUnchecked subst rhs_ty, loc) - -- We also perform other checks for well-formedness and validity - -- later, in checkValidClass + ; let subst = case traverse getTyVar_maybe pats of + Just cpt_tvs -> zipTvSubst cpt_tvs (mkTyVarTys fam_tvs) + Nothing -> emptyTCvSubst + -- The Nothing case can only be reached in invalid + -- associated type family defaults. In such cases, we + -- simply create an empty substitution and let GHC fall + -- over later, in GHC.Tc.Validity.checkValidAssocTyFamDeflt. + -- See Note [Type-checking default assoc decls]. + ; pure $ Just (substTyUnchecked subst rhs_ty, ATVI loc pats) + -- We perform checks for well-formedness and validity later, in + -- GHC.Tc.Validity.checkValidAssocTyFamDeflt. } - where - -- Checks that a pattern on the LHS of a default is a type - -- variable. If so, return the underlying type variable, and if - -- not, throw an error. - -- See Note [Type-checking default assoc decls] - extract_tv :: SDoc -- The pretty-printed default equation - -- (only used for error message purposes) - -> Type -- The particular type pattern from which to extract - -- its underlying type variable - -> ArgFlag -- The visibility of the type pattern - -- (only used for error message purposes) - -> TcM TyVar - extract_tv ppr_eqn pat pat_vis = - case getTyVar_maybe pat of - Just tv -> pure tv - Nothing -> failWithTc $ - pprWithExplicitKindsWhen (isInvisibleArgFlag pat_vis) $ - hang (text "Illegal argument" <+> quotes (ppr pat) <+> text "in:") - 2 (vcat [ppr_eqn, suggestion]) - - - -- Checks that no type variables in an associated default declaration are - -- duplicated. If that is the case, throw an error. - -- See Note [Type-checking default assoc decls] - check_all_distinct_tvs :: - SDoc -- The pretty-printed default equation (only used - -- for error message purposes) - -> [(TyVar, ArgFlag)] -- The type variable arguments in the associated - -- default declaration, along with their respective - -- visibilities (the latter are only used for error - -- message purposes) - -> TcM () - check_all_distinct_tvs ppr_eqn cpt_tvs_vis = - let dups = findDupsEq ((==) `on` fst) cpt_tvs_vis in - traverse_ - (\d -> let (pat_tv, pat_vis) = NE.head d in failWithTc $ - pprWithExplicitKindsWhen (isInvisibleArgFlag pat_vis) $ - hang (text "Illegal duplicate variable" - <+> quotes (ppr pat_tv) <+> text "in:") - 2 (vcat [ppr_eqn, suggestion])) - dups - - ppr_default_eqn :: [Type] -> Type -> SDoc - ppr_default_eqn pats rhs_ty = - quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) - <+> equals <+> ppr rhs_ty) - - suggestion :: SDoc - suggestion = text "The arguments to" <+> quotes (ppr fam_tc) - <+> text "must all be distinct type variables" - {- Note [Type-checking default assoc decls] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2513,24 +2465,29 @@ Consider this default declaration for an associated type type F (x :: j) y = Proxy x -> y Note that the class variable 'a' doesn't scope over the default assoc -decl (rather oddly I think), and (less oddly) neither does the second -argument 'b' of the associated type 'F', or the kind variable 'k'. -Instead, the default decl is treated more like a top-level type -instance. - -However we store the default rhs (Proxy x -> y) in F's TyCon, using -F's own type variables, so we need to convert it to (Proxy a -> b). -We do this by creating a substitution [j |-> k, x |-> a, b |-> y] and -applying this substitution to the RHS. +decl, nor do the type variables `k` and `b`. Instead, the default decl is +treated more like a top-level type instance. However, we store the default rhs +(Proxy x -> y) in F's TyCon, using F's own type variables, so we need to +convert it to (Proxy a -> b). We do this in the tcDefaultAssocDecl function by +creating a substitution [j |-> k, x |-> a, b |-> y] and applying this +substitution to the RHS. In order to create this substitution, we must first ensure that all of the arguments in the default instance consist of distinct type variables. -One might think that this is a simple task that could be implemented earlier -in the compiler, perhaps in the parser or the renamer. However, there are some -tricky corner cases that really do require the full power of typechecking to -weed out, as the examples below should illustrate. +Checking for this property proves surprisingly tricky. Three potential places +where GHC could check for this property include: + +1. Before typechecking (in the parser or renamer) +2. During typechecking (in tcDefaultAssocDecl) +3. After typechecking (using GHC.Tc.Validity) + +Currently, GHC picks option (3) and implements this check using +GHC.Tc.Validity.checkValidAssocTyFamDeflt. GHC previously used options (1) and +(2), but neither option quite worked out for reasons that we will explain +shortly. -First, we must check that all arguments are type variables. As a motivating +The first thing that checkValidAssocTyFamDeflt does is check that all arguments +in an associated type family default are type variables. As a motivating example, consider this erroneous program (inspired by #11361): class C a where @@ -2538,10 +2495,13 @@ example, consider this erroneous program (inspired by #11361): type F x b = x If you squint, you'll notice that the kind of `x` is actually Type. However, -we cannot substitute from [Type |-> k], so we reject this default. +we cannot substitute from [Type |-> k], so we reject this default. This also +explains why GHC no longer implements option (1) above, since figuring out that +`x`'s kind is Type would be much more difficult without the knowledge that the +typechecker provides. -Next, we must check that all arguments are distinct. Here is another offending -example, this time taken from #13971: +Next, checkValidAssocTyFamDeflt checks that all arguments are distinct. Here is +another offending example, this time taken from #13971: class C2 (a :: j) where type F2 (a :: j) (b :: k) @@ -2555,10 +2515,37 @@ if we had written `type F2 @z @z x y = SameKind @z x y`, which makes it clear that we have duplicated a use of `z` on the LHS. Therefore, `F2`'s default is also rejected. -Since the LHS of an associated type family default is always just variables, -it won't contain any tycons. Accordingly, the patterns used in the substitution -won't actually be knot-tied, even though we're in the knot. This is too -delicate for my taste, but it works. +There is one more design consideration in play here: what error message should +checkValidAssocTyFamDeflt produce if one of its checks fails? Ideally, it would +be something like this: + + Illegal duplicate variable ‘z’ in: + ‘type F2 @z @z x y = ...’ + The arguments to ‘F2’ must all be distinct type variables + +This requires printing out the arguments to the associated type family. This +can be dangerous, however. Consider this example, adapted from #18648: + + class C3 a where + type F3 a + type F3 (F3 a) = a + +F3's default is illegal, since its argument is not a bare type variable. But +note that when we typecheck F3's default, the F3 type constructor is knot-tied. +Therefore, if we print the type `F3 a` in an error message, GHC will diverge! +This is the reason why GHC no longer implements option (2) above and instead +waits until /after/ typechecking has finished, at which point the typechecker +knot has been worked out. + +As one final point, one might worry that the typechecker knot could cause the +substitution that tcDefaultAssocDecl creates to diverge, but this is not the +case. Since the LHS of a valid associated type family default is always just +variables, it won't contain any tycons. Accordingly, the patterns used in the +substitution won't actually be knot-tied, even though we're in the knot. (This +is too delicate for my taste, but it works.) If we're dealing with /invalid/ +default, such as F3's above, then we simply create an empty substitution and +rely on checkValidAssocTyFamDeflt throwing an error message afterwards before +any damage is done. -} {- ********************************************************************* @@ -4293,10 +4280,14 @@ checkValidClass cls -- since there is no possible ambiguity (#10020) -- Check that any default declarations for associated types are valid - ; whenIsJust m_dflt_rhs $ \ (rhs, loc) -> - setSrcSpan loc $ - tcAddFamInstCtxt (text "default type instance") (getName fam_tc) $ - checkValidTyFamEqn fam_tc fam_tvs (mkTyVarTys fam_tvs) rhs } + ; whenIsJust m_dflt_rhs $ \ (rhs, at_validity_info) -> + case at_validity_info of + NoATVI -> pure () + ATVI loc pats -> + setSrcSpan loc $ + tcAddFamInstCtxt (text "default type instance") (getName fam_tc) $ + do { checkValidAssocTyFamDeflt fam_tc pats + ; checkValidTyFamEqn fam_tc fam_tvs (mkTyVarTys fam_tvs) rhs }} where fam_tvs = tyConTyVars fam_tc ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -14,7 +14,7 @@ module GHC.Tc.Validity ( checkValidInstance, checkValidInstHead, validDerivPred, checkTySynRhs, checkValidCoAxiom, checkValidCoAxBranch, - checkValidTyFamEqn, checkConsistentFamInst, + checkValidTyFamEqn, checkValidAssocTyFamDeflt, checkConsistentFamInst, badATErr, arityErr, checkTyConTelescope, allDistinctTyVars @@ -73,6 +73,7 @@ import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.Foldable +import Data.Function import Data.List ( (\\), nub ) import qualified Data.List.NonEmpty as NE @@ -2117,6 +2118,68 @@ checkValidTyFamEqn fam_tc qvs typats rhs ; unless undecidable_ok $ mapM_ addErrTc (checkFamInstRhs fam_tc typats (tcTyFamInsts rhs)) } +-- | Checks that an associated type family default: +-- +-- 1. Only consists of arguments that are bare type variables, and +-- +-- 2. Has a distinct type variable in each argument. +-- +-- See @Note [Type-checking default assoc decls]@ in "GHC.Tc.TyCl". +checkValidAssocTyFamDeflt :: TyCon -- ^ of the type family + -> [Type] -- ^ Type patterns + -> TcM () +checkValidAssocTyFamDeflt fam_tc pats = + do { cpt_tvs <- zipWithM extract_tv pats pats_vis + ; check_all_distinct_tvs $ zip cpt_tvs pats_vis } + where + pats_vis :: [ArgFlag] + pats_vis = tyConArgFlags fam_tc pats + + -- Checks that a pattern on the LHS of a default is a type + -- variable. If so, return the underlying type variable, and if + -- not, throw an error. + -- See Note [Type-checking default assoc decls] + extract_tv :: Type -- The particular type pattern from which to extract + -- its underlying type variable + -> ArgFlag -- The visibility of the type pattern + -- (only used for error message purposes) + -> TcM TyVar + extract_tv pat pat_vis = + case getTyVar_maybe pat of + Just tv -> pure tv + Nothing -> failWithTc $ + pprWithExplicitKindsWhen (isInvisibleArgFlag pat_vis) $ + hang (text "Illegal argument" <+> quotes (ppr pat) <+> text "in:") + 2 (vcat [ppr_eqn, suggestion]) + + -- Checks that no type variables in an associated default declaration are + -- duplicated. If that is the case, throw an error. + -- See Note [Type-checking default assoc decls] + check_all_distinct_tvs :: + [(TyVar, ArgFlag)] -- The type variable arguments in the associated + -- default declaration, along with their respective + -- visibilities (the latter are only used for error + -- message purposes) + -> TcM () + check_all_distinct_tvs cpt_tvs_vis = + let dups = findDupsEq ((==) `on` fst) cpt_tvs_vis in + traverse_ + (\d -> let (pat_tv, pat_vis) = NE.head d in failWithTc $ + pprWithExplicitKindsWhen (isInvisibleArgFlag pat_vis) $ + hang (text "Illegal duplicate variable" + <+> quotes (ppr pat_tv) <+> text "in:") + 2 (vcat [ppr_eqn, suggestion])) + dups + + ppr_eqn :: SDoc + ppr_eqn = + quotes (text "type" <+> ppr (mkTyConApp fam_tc pats) + <+> equals <+> text "...") + + suggestion :: SDoc + suggestion = text "The arguments to" <+> quotes (ppr fam_tc) + <+> text "must all be distinct type variables" + -- Make sure that each type family application is -- (1) strictly smaller than the lhs, -- (2) mentions no type variable more often than the lhs, and ===================================== testsuite/tests/indexed-types/should_compile/T11361a.stderr ===================================== @@ -1,7 +1,7 @@ T11361a.hs:7:3: error: • Illegal argument ‘*’ in: - ‘type F @(*) x = x’ + ‘type F @(*) x = ...’ The arguments to ‘F’ must all be distinct type variables • In the default type instance declaration for ‘F’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/SimpleFail4.stderr ===================================== @@ -1,7 +1,7 @@ SimpleFail4.hs:10:3: error: • Illegal argument ‘Int’ in: - ‘type S2 Int = Char’ + ‘type S2 Int = ...’ The arguments to ‘S2’ must all be distinct type variables • In the default type instance declaration for ‘S2’ In the class declaration for ‘C2’ ===================================== testsuite/tests/indexed-types/should_fail/T13971.stderr ===================================== @@ -1,7 +1,7 @@ T13971.hs:7:3: error: • Illegal argument ‘*’ in: - ‘type T @{k} @(*) a = Int’ + ‘type T @{k} @(*) a = ...’ The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T13971b.stderr ===================================== @@ -1,7 +1,7 @@ T13971b.hs:9:3: error: • Illegal duplicate variable ‘k’ in: - ‘type T @k @k a b = k’ + ‘type T @k @k a b = ...’ The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T16110_Fail2.stderr ===================================== @@ -1,7 +1,7 @@ T16110_Fail2.hs:9:3: error: • Illegal duplicate variable ‘b’ in: - ‘type T a b b = Int’ + ‘type T a b b = ...’ The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T16110_Fail3.stderr ===================================== @@ -1,7 +1,7 @@ T16110_Fail3.hs:11:3: error: • Illegal argument ‘Int’ in: - ‘type T a Int = Int’ + ‘type T a Int = ...’ The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T16356_Fail1.stderr ===================================== @@ -1,7 +1,7 @@ T16356_Fail1.hs:10:3: error: • Illegal argument ‘*’ in: - ‘type T @(*) a = Maybe a’ + ‘type T @(*) a = ...’ The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T16356_Fail2.stderr ===================================== @@ -1,7 +1,7 @@ T16356_Fail2.hs:8:3: error: • Illegal duplicate variable ‘k’ in: - ‘type T @k @k a b = k’ + ‘type T @k @k a b = ...’ The arguments to ‘T’ must all be distinct type variables • In the default type instance declaration for ‘T’ In the class declaration for ‘C’ ===================================== testsuite/tests/indexed-types/should_fail/T18648.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE TypeFamilies #-} +module T18648 where + +class Foo1 a where + type Bar1 a + type Bar1 (f a) = Bar1 a + +class Foo2 a where + type Bar2 a + type Bar2 (Bar2 a) = a ===================================== testsuite/tests/indexed-types/should_fail/T18648.stderr ===================================== @@ -0,0 +1,14 @@ + +T18648.hs:6:4: error: + • Illegal argument ‘f a’ in: + ‘type Bar1 (f a) = ...’ + The arguments to ‘Bar1’ must all be distinct type variables + • In the default type instance declaration for ‘Bar1’ + In the class declaration for ‘Foo1’ + +T18648.hs:10:4: error: + • Illegal argument ‘Bar2 a’ in: + ‘type Bar2 (Bar2 a) = ...’ + The arguments to ‘Bar2’ must all be distinct type variables + • In the default type instance declaration for ‘Bar2’ + In the class declaration for ‘Foo2’ ===================================== testsuite/tests/indexed-types/should_fail/all.T ===================================== @@ -162,3 +162,4 @@ test('T16356_Fail3', normal, compile_fail, ['']) test('T17008a', normal, compile_fail, ['-fprint-explicit-kinds']) test('T13571', normal, compile_fail, ['']) test('T13571a', normal, compile_fail, ['']) +test('T18648', normal, compile_fail, ['']) ===================================== testsuite/tests/typecheck/should_fail/AssocTyDef02.stderr ===================================== @@ -1,7 +1,7 @@ AssocTyDef02.hs:6:5: error: • Illegal argument ‘[b]’ in: - ‘type Typ [b] = Int’ + ‘type Typ [b] = ...’ The arguments to ‘Typ’ must all be distinct type variables • In the default type instance declaration for ‘Typ’ In the class declaration for ‘Cls’ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/822f10575d207a2a47b21ac853dcf28c655041c4 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/822f10575d207a2a47b21ac853dcf28c655041c4 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 07:11:39 2020 From: gitlab at gitlab.haskell.org (Sven Tennie) Date: Wed, 09 Sep 2020 03:11:39 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] Define a public API for Printer.c (#18405) Message-ID: <5f58802b25e38_80b3f8429a4247c11161237@gitlab.haskell.org.mail> Sven Tennie pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: 25c2a49b by Sven Tennie at 2020-09-09T09:11:19+02:00 Define a public API for Printer.c (#18405) The RtsAPI contains functions to inspect the heap. The published Printer.c functions help to print the found closures. - - - - - 3 changed files: - + includes/rts/PrinterAPI.h - rts/Printer.c - rts/Printer.h Changes: ===================================== includes/rts/PrinterAPI.h ===================================== @@ -0,0 +1,23 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 2020 + * + * Public API of closure printing functions. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +// findPtrCb takes a callback of type FindPtrCb, so external tools (such as +// ghc-debug) can invoke it and intercept the intermediate results. +// When findPtrCb successfully finds a closure containing an address then the +// callback is called on the address of that closure. +// The `StgClosure` argument is an untagged closure pointer. +// `user` points to any data provided by the caller. It's not used internally. +typedef void (*FindPtrCb)(void *user, StgClosure *); + +void findPtrCb(FindPtrCb cb, void *, P_ p); + +// Special case of findPtrCb: Uses a default callback, that prints the closure +// pointed to by p. +void findPtr(P_ p, int follow); ===================================== rts/Printer.c ===================================== @@ -852,17 +852,6 @@ extern void DEBUG_LoadSymbols( const char *name STG_UNUSED ) #endif /* USING_LIBBFD */ -// findPtrCb takes a callback of type FindPtrCb, so external tools (such as -// ghc-debug) can invoke it and intercept the intermediate results. -// When findPtrCb successfully finds a closure containing an address then the -// callback is called on the address of that closure. -// The `StgClosure` argument is an untagged closure pointer. -// `user` points to any data provided by the caller. It's not used internally. -typedef void (*FindPtrCb)(void *user, StgClosure *); - -void findPtr(P_ p, int); /* keep gcc -Wall happy */ -void findPtrCb(FindPtrCb cb, void *, P_ p); /* keep gcc -Wall happy */ - static void findPtr_default_callback(void *user STG_UNUSED, StgClosure * closure){ debugBelch("%p = ", closure); ===================================== rts/Printer.h ===================================== @@ -10,6 +10,8 @@ #include "BeginPrivate.h" +#include "rts/PrinterAPI.h" + extern void printPtr ( StgPtr p ); extern void printObj ( StgClosure *obj ); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25c2a49b894b33e94b24423b485ef6a0bbfede9e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/25c2a49b894b33e94b24423b485ef6a0bbfede9e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 09:35:27 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 09 Sep 2020 05:35:27 -0400 Subject: [Git][ghc/ghc][wip/T18649] Care with implicit-parameter superclasses Message-ID: <5f58a1dfb5ff0_80b3f846802cfe8111717c9@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18649 at Glasgow Haskell Compiler / GHC Commits: 2292eeab by Simon Peyton Jones at 2020-09-09T10:28:57+01:00 Care with implicit-parameter superclasses Two bugs, #18627 and #18649, had the same cause: we were not account for the fact that a constaint tuple might hide an implicit parameter. The solution is not hard: look for implicit parameters in superclasses. See Note [Local implicit parameters] in GHC.Core.Predicate. Then we use this new function in two places * The "short-cut solver" in GHC.Tc.Solver.Interact.shortCutSolver which simply didn't handle implicit parameters properly at all. This fixes #18627 * The specialiser, which should not specialise on implicit parameters This fixes #18649 There are some lingering worries (see Note [Local implicit parameters]) but things are much better. - - - - - 12 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - + testsuite/tests/simplCore/should_compile/T18649.hs - + testsuite/tests/simplCore/should_compile/T18649.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_run/T18627.hs - + testsuite/tests/typecheck/should_run/T18627.stdout - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2510,9 +2510,12 @@ mkCallUDs' env f args -- we decide on a case by case basis if we want to specialise -- on this argument; if so, SpecDict, if not UnspecArg mk_spec_arg arg (Anon InvisArg pred) - | type_determines_value (scaledThing pred) - , interestingDict env arg -- Note [Interesting dictionary arguments] + | not (isIPLikePred (scaledThing pred)) + -- See Note [Type determines value] + , interestingDict env arg + -- See Note [Interesting dictionary arguments] = SpecDict arg + | otherwise = UnspecArg mk_spec_arg _ (Anon VisArg _) @@ -2525,41 +2528,18 @@ mkCallUDs' env f args -- in specImports -- Use 'realIdUnfolding' to ignore the loop-breaker flag! - type_determines_value pred -- See Note [Type determines value] - = case classifyPredType pred of - ClassPred cls _ -> not (isIPClass cls) -- Superclasses can't be IPs - EqPred {} -> True - IrredPred {} -> True -- Things like (D []) where D is a - -- Constraint-ranged family; #7785 - ForAllPred {} -> True - -{- -Note [Type determines value] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Only specialise on non-IP *class* params, because these are the ones -whose *type* determines their *value*. In particular, with implicit -params, the type args *don't* say what the value of the implicit param -is! See #7101. +{- Note [Type determines value] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Only specialise on non-impicit-parameter predicates, because these +are the ones whose *type* determines their *value*. In particular, +with implicit params, the type args *don't* say what the value of the +implicit param is! See #7101. So we treat implicit params just like ordinary arguments for the purposes of specialisation. Note that we still want to specialise functions with implicit params if they have *other* dicts which are class params; see #17930. -One apparent additional complexity involves type families. For -example, consider - type family D (v::*->*) :: Constraint - type instance D [] = () - f :: D v => v Char -> Int -If we see a call (f "foo"), we'll pass a "dictionary" - () |> (g :: () ~ D []) -and it's good to specialise f at this dictionary. - -So the question is: can an implicit parameter "hide inside" a -type-family constraint like (D a). Well, no. We don't allow - type instance D Maybe = ?x:Int -Hence the IrredPred case in type_determines_value. See #7785. - Note [Interesting dictionary arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Core.Predicate ( getClassPredTys, getClassPredTys_maybe, -- Implicit parameters - isIPPred, isIPPred_maybe, isIPTyCon, isIPClass, hasIPPred, + isIPLikePred, hasIPSuperClasses, isIPTyCon, isIPClass, -- Evidence variables DictId, isEvVar, isDictId @@ -39,12 +39,10 @@ import GHC.Core.Multiplicity ( scaledThing ) import GHC.Builtin.Names -import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic -import Control.Monad ( guard ) -- | A predicate in the solver. The solver tries to prove Wanted predicates -- from Given ones. @@ -170,7 +168,7 @@ isEqPredClass :: Class -> Bool isEqPredClass cls = cls `hasKey` eqTyConKey || cls `hasKey` heqTyConKey -isClassPred, isEqPred, isEqPrimPred, isIPPred :: PredType -> Bool +isClassPred, isEqPred, isEqPrimPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tyCon | isClassTyCon tyCon -> True _ -> False @@ -186,9 +184,15 @@ isEqPred ty -- True of (a ~ b) and (a ~~ b) isEqPrimPred ty = isCoVarType ty -- True of (a ~# b) (a ~R# b) -isIPPred ty = case tyConAppTyCon_maybe ty of - Just tc -> isIPTyCon tc - _ -> False +isCTupleClass :: Class -> Bool +isCTupleClass cls = isTupleTyCon (classTyCon cls) + + +{- ********************************************************************* +* * + Implicit parameters +* * +********************************************************************* -} isIPTyCon :: TyCon -> Bool isIPTyCon tc = tc `hasKey` ipClassKey @@ -197,31 +201,105 @@ isIPTyCon tc = tc `hasKey` ipClassKey isIPClass :: Class -> Bool isIPClass cls = cls `hasKey` ipClassKey -isCTupleClass :: Class -> Bool -isCTupleClass cls = isTupleTyCon (classTyCon cls) +isIPLikePred :: Type -> Bool +-- See Note [Local implicit parameters] +isIPLikePred = is_ip_like_pred initIPRecTc -isIPPred_maybe :: Type -> Maybe (FastString, Type) -isIPPred_maybe ty = - do (tc,[t1,t2]) <- splitTyConApp_maybe ty - guard (isIPTyCon tc) - x <- isStrLitTy t1 - return (x,t2) - -hasIPPred :: PredType -> Bool -hasIPPred pred - = case classifyPredType pred of - ClassPred cls tys - | isIPClass cls -> True - | isCTupleClass cls -> any hasIPPred tys - _other -> False -{- -************************************************************************ +is_ip_like_pred :: RecTcChecker -> Type -> Bool +is_ip_like_pred rec_clss ty + | Just (tc, tys) <- splitTyConApp_maybe ty + , Just rec_clss' <- if isTupleTyCon tc -- Tuples never cause recursion + then Just rec_clss + else checkRecTc rec_clss tc + , Just cls <- tyConClass_maybe tc + = isIPClass cls || has_ip_super_classes rec_clss' cls tys + + | otherwise + = False -- Includes things like (D []) where D is + -- a Constraint-ranged family; #7785 + +hasIPSuperClasses :: Class -> [Type] -> Bool +-- See Note [Local implicit parameters] +hasIPSuperClasses = has_ip_super_classes initIPRecTc + +has_ip_super_classes :: RecTcChecker -> Class -> [Type] -> Bool +has_ip_super_classes rec_clss cls tys + = any ip_ish (classSCSelIds cls) + where + -- Check that the type of a superclass determines its value + -- sc_sel_id :: forall a b. C a b -> + ip_ish sc_sel_id = is_ip_like_pred rec_clss $ + funResultTy $ + piResultTys (varType sc_sel_id) tys + + +initIPRecTc :: RecTcChecker +initIPRecTc = setRecTcMaxBound 1 initRecTc + +{- Note [Local implicit parameters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The function isIPLikePred tells if this predicate, or any of its +superclasses, is an implicit parameter. + +Why are implicit parameters special? Unlike normal classes, we can +have local instances for implicit parameters, in the form of + let ?x = True in ... +So in various places we must be careful not to assume that any value +of the right type will do; we must carefully look for the innermost binding. +So isIPLikePred checks whether this is an implicit parameter, or has +a superclass that is an implicit parameter. + +Several wrinkles + +* We must be careful with superclasses, as #18649 showed. Haskell + doesn't allow an implicit parameter as a superclass + class (?x::a) => C a where ... + but with a constraint tuple we might have + (% Eq a, ?x::Int %) + and /its/ superclasses, namely (Eq a) and (?x::Int), /do/ include an + implicit parameter. + + With ConstraintKinds this can apply to /any/ class, e.g. + class sc => C sc where ... + Then (C (?x::Int)) has (?x::Int) as a superclass. So we must + instantiate and check each superclass, one by one, in + hasIPSuperClasses. + +* With -XRecursiveSuperClasses, the superclass hunt can go on forever, + so we need a RecTcChecker to cut it off. + +* Another apparent additional complexity involves type families. For + example, consider + type family D (v::*->*) :: Constraint + type instance D [] = () + f :: D v => v Char -> Int + If we see a call (f "foo"), we'll pass a "dictionary" + () |> (g :: () ~ D []) + and it's good to specialise f at this dictionary. + +So the question is: can an implicit parameter "hide inside" a +type-family constraint like (D a). Well, no. We don't allow + type instance D Maybe = ?x:Int +Hence the umbrella 'otherwise' case in is_ip_like_pred. See #7785. + +Small worries (Sept 20): +* I don't see what stops us having that 'type instance'. Indeed I + think nothing does. +* I'm a little concerned about type variables; such a variable might + be instantiated to an implicit parameter. I don't think this + matters in the cases for which isIPLikePred is used, and it's pretty + obscure anyway. +* The superclass hunt stops when it encounters the same class again, + but in principle we could have the same class, differently instantiated, + and the second time it could have an implicit parameter +I'm going to treat these as problems for another day. They are all exotic. -} + +{- ********************************************************************* * * Evidence variables * * -************************************************************************ --} +********************************************************************* -} isEvVar :: Var -> Bool isEvVar var = isEvVarType (varType var) ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1377,7 +1377,7 @@ growThetaTyVars theta tcvs | otherwise = transCloVarSet mk_next seed_tcvs where seed_tcvs = tcvs `unionVarSet` tyCoVarsOfTypes ips - (ips, non_ips) = partition isIPPred theta + (ips, non_ips) = partition isIPLikePred theta -- See Note [Inheriting implicit parameters] in GHC.Tc.Utils.TcType mk_next :: VarSet -> VarSet -- Maps current set to newly-grown ones ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -566,10 +566,10 @@ solveOneFromTheOther ev_i ev_w ev_id_w = ctEvEvId ev_w different_level_strategy -- Both Given - | isIPPred pred = if lvl_w > lvl_i then KeepWork else KeepInert - | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork + | isIPLikePred pred = if lvl_w > lvl_i then KeepWork else KeepInert + | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork -- See Note [Replacement vs keeping] (the different-level bullet) - -- For the isIPPred case see Note [Shadowing of Implicit Parameters] + -- For the isIPLikePred case see Note [Shadowing of Implicit Parameters] same_level_strategy binds -- Both Given | GivenOrigin (InstSC s_i) <- ctLocOrigin loc_i @@ -1071,6 +1071,8 @@ shortCutSolver dflags ev_w ev_i -- programs should typecheck regardless of whether we take this step or -- not. See Note [Shortcut solving] + && not (isIPLikePred (ctEvPred ev_w)) -- Not for implicit parameters (#18627) + && not (xopt LangExt.IncoherentInstances dflags) -- If IncoherentInstances is on then we cannot rely on coherence of proofs -- in order to justify this optimization: The proof provided by the @@ -1079,6 +1081,7 @@ shortCutSolver dflags ev_w ev_i && gopt Opt_SolveConstantDicts dflags -- Enabled by the -fsolve-constant-dicts flag + = do { ev_binds_var <- getTcEvBindsVar ; ev_binds <- ASSERT2( not (isCoEvBindsVar ev_binds_var ), ppr ev_w ) getTcEvBindsMap ev_binds_var ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2527,8 +2527,7 @@ emptyDictMap = emptyTcAppMap findDict :: DictMap a -> CtLoc -> Class -> [Type] -> Maybe a findDict m loc cls tys - | isCTupleClass cls - , any hasIPPred tys -- See Note [Tuples hiding implicit parameters] + | hasIPSuperClasses cls tys -- See Note [Tuples hiding implicit parameters] = Nothing | Just {} <- isCallStackPred cls tys ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -79,7 +79,7 @@ module GHC.Tc.Utils.TcType ( isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, isBoolTy, isUnitTy, isCharTy, isCallStackTy, isCallStackPred, - hasIPPred, isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, + isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, isPredTy, isTyVarClassPred, isTyVarHead, isInsolubleOccursCheck, checkValidClsArgs, hasTyVarHead, isRigidTy, isAlmostFunctionFree, @@ -141,7 +141,7 @@ module GHC.Tc.Utils.TcType ( mkTyConTy, mkTyVarTy, mkTyVarTys, mkTyCoVarTy, mkTyCoVarTys, - isClassPred, isEqPrimPred, isIPPred, isEqPred, isEqPredClass, + isClassPred, isEqPrimPred, isIPLikePred, isEqPred, isEqPredClass, mkClassPred, tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy, isRuntimeRepVar, isKindLevPoly, @@ -1747,7 +1747,7 @@ pickCapturedPreds pickCapturedPreds qtvs theta = filter captured theta where - captured pred = isIPPred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) + captured pred = isIPLikePred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) -- Superclasses ===================================== testsuite/tests/simplCore/should_compile/T18649.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} + +module Test where + +import Prelude + +type Hidden a = + ( ?enable :: a + , Eq a -- removing this "fixes" the issue + ) + +{-# NOINLINE a #-} +a :: Hidden Bool => Integer -> Bool +a _ = ?enable + +system :: Hidden Bool => Bool +system = a 0 + +topEntity :: Bool -> Bool +topEntity ena = let ?enable = ena + in system + +someVar = let ?enable = True + in system ===================================== testsuite/tests/simplCore/should_compile/T18649.stderr ===================================== @@ -0,0 +1,4 @@ + +==================== Tidy Core rules ==================== + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -333,3 +333,7 @@ test('T18347', normal, compile, ['-dcore-lint -O']) test('T18355', [ grep_errmsg(r'OneShot') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T18399', normal, compile, ['-dcore-lint -O']) test('T18589', normal, compile, ['-dcore-lint -O']) + +# T18648 should /not/ generate a specialisation rule +test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) + ===================================== testsuite/tests/typecheck/should_run/T18627.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Main where + +import GHC.Classes + +instance IP "x" Int where + ip = 21 + +baz :: (?x :: Int) => Int +baz = ?x + +main :: IO () +main = let ?x = 42 + in print baz ===================================== testsuite/tests/typecheck/should_run/T18627.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -146,3 +146,4 @@ test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, ['']) test('UnliftedNewtypesIdentityRun', normal, compile_and_run, ['']) test('UnliftedNewtypesCoerceRun', normal, compile_and_run, ['']) test('T17104', normal, compile_and_run, ['']) +test('T18627', normal, compile_and_run, ['-O']) # Optimisation shows up the bug View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2292eeab80ac065ac33c155908b7883898f98be9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2292eeab80ac065ac33c155908b7883898f98be9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 10:19:25 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 09 Sep 2020 06:19:25 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: Use "to" instead of "2" in internal names of conversion ops Message-ID: <5f58ac2d308f9_80b3f8496240748111821af@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 03db4355 by Sylvain Henry at 2020-09-09T06:19:17-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - d34209f3 by Sylvain Henry at 2020-09-09T06:19:17-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - d2c272d1 by Sylvain Henry at 2020-09-09T06:19:17-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - cb93c10d by Sylvain Henry at 2020-09-09T06:19:17-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - f7fe3adc by Alan Zimmerman at 2020-09-09T06:19:17-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/SimpleOpt.hs - + compiler/GHC/Core/SimpleOpt.hs-boot - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold.hs-boot - + compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - + compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c862c673eaababb1d81a6e3d4ecf8a4eefd8401d...f7fe3adc5e0ce745e9882d5915f95dad9f6a626b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c862c673eaababb1d81a6e3d4ecf8a4eefd8401d...f7fe3adc5e0ce745e9882d5915f95dad9f6a626b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 12:45:12 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 09 Sep 2020 08:45:12 -0400 Subject: =?UTF-8?Q?[Git][ghc/ghc][wip/T18341]_PmCheck:_Handle_=E2=8A=A5_and?= =?UTF-8?Q?_strict_fields_correctly_=28#18341=29?= Message-ID: <5f58ce5865321_80b3f84296a379411201744@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18341 at Glasgow Haskell Compiler / GHC Commits: 065216d4 by Sebastian Graf at 2020-09-09T14:44:46+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 27 changed files: - compiler/GHC/Core/DataCon.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/HsToCore/PmCheck/Types.hs-boot - compiler/GHC/Tc/Types.hs - + testsuite/tests/pmcheck/should_compile/T10183.hs - testsuite/tests/pmcheck/should_compile/T17340.stderr - + testsuite/tests/pmcheck/should_compile/T17378.hs - + testsuite/tests/pmcheck/should_compile/T17725.hs - + testsuite/tests/pmcheck/should_compile/T17725.stderr - + testsuite/tests/pmcheck/should_compile/T17729.hs - + testsuite/tests/pmcheck/should_compile/T17729.stderr - + testsuite/tests/pmcheck/should_compile/T17977.stderr - + testsuite/tests/pmcheck/should_compile/T18273.hs - + testsuite/tests/pmcheck/should_compile/T18341.hs - + testsuite/tests/pmcheck/should_compile/T18341.stderr - + testsuite/tests/pmcheck/should_compile/T18670.hs - + testsuite/tests/pmcheck/should_compile/T18670.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -53,7 +53,7 @@ module GHC.Core.DataCon ( -- ** Predicates on DataCons isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isUnboxedTupleCon, isUnboxedSumCon, - isVanillaDataCon, classDataCon, dataConCannotMatch, + isVanillaDataCon, isNewDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsArePermuted, isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked, specialPromotedDc, @@ -1477,6 +1477,10 @@ isUnboxedSumCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc isVanillaDataCon :: DataCon -> Bool isVanillaDataCon dc = dcVanilla dc +-- | Is this the 'DataCon' of a newtype? +isNewDataCon :: DataCon -> Bool +isNewDataCon dc = isNewTyCon (dataConTyCon dc) + -- | Should this DataCon be allowed in a type even without -XDataKinds? -- Currently, only Lifted & Unlifted specialPromotedDc :: DataCon -> Bool ===================================== compiler/GHC/Data/Bag.hs ===================================== @@ -6,7 +6,7 @@ Bag: an unordered collection with duplicates -} -{-# LANGUAGE ScopedTypeVariables, CPP, DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, CPP, DeriveFunctor, TypeFamilies #-} module GHC.Data.Bag ( Bag, -- abstract type @@ -27,9 +27,9 @@ module GHC.Data.Bag ( import GHC.Prelude +import GHC.Exts ( IsList(..) ) import GHC.Utils.Outputable import GHC.Utils.Misc - import GHC.Utils.Monad import Control.Monad import Data.Data @@ -333,3 +333,8 @@ instance Traversable Bag where traverse f (UnitBag x) = UnitBag <$> f x traverse f (TwoBags b1 b2) = TwoBags <$> traverse f b1 <*> traverse f b2 traverse f (ListBag xs) = ListBag <$> traverse f xs + +instance IsList (Bag a) where + type Item (Bag a) = a + fromList = listToBag + toList = bagToList ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -184,8 +184,8 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = ty , pat_ticks = (rhs_tick, var_ticks) }) - = do { rhss_deltas <- covCheckGRHSs PatBindGuards grhss - ; body_expr <- dsGuarded grhss ty rhss_deltas + = do { rhss_nablas <- covCheckGRHSs PatBindGuards grhss + ; body_expr <- dsGuarded grhss ty rhss_nablas ; let body' = mkOptTickBox rhs_tick body_expr pat' = decideBangHood dflags pat ; (force_var,sel_binds) <- mkSelectorBinds var_ticks pat body' ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -215,8 +215,8 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss , pat_ext = ty }) body = -- let C x# y# = rhs in body -- ==> case rhs of C x# y# -> body - do { match_deltas <- covCheckGRHSs PatBindGuards grhss - ; rhs <- dsGuarded grhss ty match_deltas + do { match_nablas <- covCheckGRHSs PatBindGuards grhss + ; rhs <- dsGuarded grhss ty match_nablas ; let upat = unLoc pat eqn = EqnInfo { eqn_pats = [upat], eqn_orig = FromSource, @@ -486,8 +486,8 @@ dsExpr (HsMultiIf res_ty alts) | otherwise = do { let grhss = GRHSs noExtField alts (noLoc emptyLocalBinds) - ; rhss_deltas <- covCheckGRHSs IfAlt grhss - ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_deltas + ; rhss_nablas <- covCheckGRHSs IfAlt grhss + ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_nablas ; error_expr <- mkErrorExpr ; extractMatchResult match_result error_expr } where ===================================== compiler/GHC/HsToCore/GuardedRHSs.hs ===================================== @@ -25,7 +25,7 @@ import GHC.Core.Utils (bindNonRec) import GHC.HsToCore.Monad import GHC.HsToCore.Utils -import GHC.HsToCore.PmCheck.Types ( Deltas ) +import GHC.HsToCore.PmCheck.Types ( Nablas ) import GHC.Core.Type ( Type ) import GHC.Utils.Misc import GHC.Types.SrcLoc @@ -48,9 +48,9 @@ producing an expression with a runtime error in the corner case if necessary. The type argument gives the type of the @ei at . -} -dsGuarded :: GRHSs GhcTc (LHsExpr GhcTc) -> Type -> NonEmpty Deltas -> DsM CoreExpr -dsGuarded grhss rhs_ty rhss_deltas = do - match_result <- dsGRHSs PatBindRhs grhss rhs_ty rhss_deltas +dsGuarded :: GRHSs GhcTc (LHsExpr GhcTc) -> Type -> NonEmpty Nablas -> DsM CoreExpr +dsGuarded grhss rhs_ty rhss_nablas = do + match_result <- dsGRHSs PatBindRhs grhss rhs_ty rhss_nablas error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty empty extractMatchResult match_result error_expr @@ -59,28 +59,28 @@ dsGuarded grhss rhs_ty rhss_deltas = do dsGRHSs :: HsMatchContext GhcRn -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ Guarded RHSs -> Type -- ^ Type of RHS - -> NonEmpty Deltas -- ^ Refined pattern match checking + -> NonEmpty Nablas -- ^ Refined pattern match checking -- models, one for the pattern part and -- one for each GRHS. -> DsM (MatchResult CoreExpr) -dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty rhss_deltas +dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty rhss_nablas = ASSERT( notNull grhss ) - do { match_results <- ASSERT( length grhss == length rhss_deltas ) - zipWithM (dsGRHS hs_ctx rhs_ty) (toList rhss_deltas) grhss - ; deltas <- getPmDeltas - -- We need to remember the Deltas from the particular match context we + do { match_results <- ASSERT( length grhss == length rhss_nablas ) + zipWithM (dsGRHS hs_ctx rhs_ty) (toList rhss_nablas) grhss + ; nablas <- getPmNablas + -- We need to remember the Nablas from the particular match context we -- are in, which might be different to when dsLocalBinds is actually -- called. - ; let ds_binds = updPmDeltas deltas . dsLocalBinds binds + ; let ds_binds = updPmNablas nablas . dsLocalBinds binds match_result1 = foldr1 combineMatchResults match_results match_result2 = adjustMatchResultDs ds_binds match_result1 -- NB: nested dsLet inside matchResult ; return match_result2 } -dsGRHS :: HsMatchContext GhcRn -> Type -> Deltas -> LGRHS GhcTc (LHsExpr GhcTc) +dsGRHS :: HsMatchContext GhcRn -> Type -> Nablas -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (MatchResult CoreExpr) -dsGRHS hs_ctx rhs_ty rhs_deltas (L _ (GRHS _ guards rhs)) - = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs_deltas rhs rhs_ty +dsGRHS hs_ctx rhs_ty rhs_nablas (L _ (GRHS _ guards rhs)) + = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs_nablas rhs rhs_ty {- ************************************************************************ @@ -92,7 +92,7 @@ dsGRHS hs_ctx rhs_ty rhs_deltas (L _ (GRHS _ guards rhs)) matchGuards :: [GuardStmt GhcTc] -- Guard -> HsStmtContext GhcRn -- Context - -> Deltas -- The RHS's covered set for PmCheck + -> Nablas -- The RHS's covered set for PmCheck -> LHsExpr GhcTc -- RHS -> Type -- Type of RHS of guard -> DsM (MatchResult CoreExpr) @@ -100,8 +100,8 @@ matchGuards :: [GuardStmt GhcTc] -- Guard -- See comments with HsExpr.Stmt re what a BodyStmt means -- Here we must be in a guard context (not do-expression, nor list-comp) -matchGuards [] _ deltas rhs _ - = do { core_rhs <- updPmDeltas deltas (dsLExpr rhs) +matchGuards [] _ nablas rhs _ + = do { core_rhs <- updPmNablas nablas (dsLExpr rhs) ; return (cantFailMatchResult core_rhs) } -- BodyStmts must be guards @@ -111,31 +111,31 @@ matchGuards [] _ deltas rhs _ -- NB: The success of this clause depends on the typechecker not -- wrapping the 'otherwise' in empty HsTyApp or HsWrap constructors -- If it does, you'll get bogus overlap warnings -matchGuards (BodyStmt _ e _ _ : stmts) ctx deltas rhs rhs_ty +matchGuards (BodyStmt _ e _ _ : stmts) ctx nablas rhs rhs_ty | Just addTicks <- isTrueLHsExpr e = do - match_result <- matchGuards stmts ctx deltas rhs rhs_ty + match_result <- matchGuards stmts ctx nablas rhs rhs_ty return (adjustMatchResultDs addTicks match_result) -matchGuards (BodyStmt _ expr _ _ : stmts) ctx deltas rhs rhs_ty = do - match_result <- matchGuards stmts ctx deltas rhs rhs_ty +matchGuards (BodyStmt _ expr _ _ : stmts) ctx nablas rhs rhs_ty = do + match_result <- matchGuards stmts ctx nablas rhs rhs_ty pred_expr <- dsLExpr expr return (mkGuardedMatchResult pred_expr match_result) -matchGuards (LetStmt _ binds : stmts) ctx deltas rhs rhs_ty = do - match_result <- matchGuards stmts ctx deltas rhs rhs_ty +matchGuards (LetStmt _ binds : stmts) ctx nablas rhs rhs_ty = do + match_result <- matchGuards stmts ctx nablas rhs rhs_ty return (adjustMatchResultDs (dsLocalBinds binds) match_result) -- NB the dsLet occurs inside the match_result -- Reason: dsLet takes the body expression as its argument -- so we can't desugar the bindings without the -- body expression in hand -matchGuards (BindStmt _ pat bind_rhs : stmts) ctx deltas rhs rhs_ty = do +matchGuards (BindStmt _ pat bind_rhs : stmts) ctx nablas rhs rhs_ty = do let upat = unLoc pat match_var <- selectMatchVar Many upat -- We only allow unrestricted patterns in guard, hence the `Many` -- above. It isn't clear what linear patterns would mean, maybe we will -- figure it out in the future. - match_result <- matchGuards stmts ctx deltas rhs rhs_ty + match_result <- matchGuards stmts ctx nablas rhs rhs_ty core_rhs <- dsLExpr bind_rhs match_result' <- matchSinglePatVar match_var (Just core_rhs) (StmtCtxt ctx) pat rhs_ty match_result ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -35,7 +35,7 @@ import GHC.Tc.Utils.Zonk import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad import GHC.HsToCore.PmCheck -import GHC.HsToCore.PmCheck.Types ( Deltas, initDeltas ) +import GHC.HsToCore.PmCheck.Types ( Nablas, initNablas ) import GHC.Core import GHC.Types.Literal import GHC.Core.Utils @@ -766,31 +766,31 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches (hsLMatchPats m)) -- Pattern match check warnings for /this match-group/. - -- @rhss_deltas@ is a flat list of covered Deltas for each RHS. - -- Each Match will split off one Deltas for its RHSs from this. - ; matches_deltas <- if isMatchContextPmChecked dflags origin ctxt + -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. + -- Each Match will split off one Nablas for its RHSs from this. + ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt then addHsScrutTmCs mb_scr new_vars $ -- See Note [Long-distance information] covCheckMatches (DsMatchContext ctxt locn) new_vars matches - else pure (initDeltasMatches matches) + else pure (initNablasMatches matches) - ; eqns_info <- zipWithM mk_eqn_info matches matches_deltas + ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas ; result_expr <- handleWarnings $ matchEquations ctxt new_vars eqns_info rhs_ty ; return (new_vars, result_expr) } where -- Called once per equation in the match, or alternative in the case - mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Deltas, NonEmpty Deltas) -> DsM EquationInfo - mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_deltas, rhss_deltas) + mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo + mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas) = do { dflags <- getDynFlags ; let upats = map (unLoc . decideBangHood dflags) pats - -- pat_deltas is the covered set *after* matching the pattern, but - -- before any of the GRHSs. We extend the environment with pat_deltas - -- (via updPmDeltas) so that the where-clause of 'grhss' can profit + -- pat_nablas is the covered set *after* matching the pattern, but + -- before any of the GRHSs. We extend the environment with pat_nablas + -- (via updPmNablas) so that the where-clause of 'grhss' can profit -- from that knowledge (#18533) - ; match_result <- updPmDeltas pat_deltas $ - dsGRHSs ctxt grhss rhs_ty rhss_deltas + ; match_result <- updPmNablas pat_nablas $ + dsGRHSs ctxt grhss rhs_ty rhss_nablas ; return EqnInfo { eqn_pats = upats , eqn_orig = FromSource , eqn_rhs = match_result } } @@ -799,14 +799,14 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches then discardWarningsDs else id - initDeltasMatches :: [LMatch GhcTc b] -> [(Deltas, NonEmpty Deltas)] - initDeltasMatches ms - = map (\(L _ m) -> (initDeltas, initDeltasGRHSs (m_grhss m))) ms + initNablasMatches :: [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] + initNablasMatches ms + = map (\(L _ m) -> (initNablas, initNablasGRHSs (m_grhss m))) ms - initDeltasGRHSs :: GRHSs GhcTc b -> NonEmpty Deltas - initDeltasGRHSs m = expectJust "GRHSs non-empty" + initNablasGRHSs :: GRHSs GhcTc b -> NonEmpty Nablas + initNablasGRHSs m = expectJust "GRHSs non-empty" $ NEL.nonEmpty - $ replicate (length (grhssGRHSs m)) initDeltas + $ replicate (length (grhssGRHSs m)) initNablas matchEquations :: HsMatchContext GhcRn ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -34,7 +34,7 @@ module GHC.HsToCore.Monad ( DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv, -- Getting and setting pattern match oracle states - getPmDeltas, updPmDeltas, + getPmNablas, updPmNablas, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -304,7 +304,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span - , dsl_deltas = initDeltas + , dsl_nablas = initNablas } in (gbl_env, lcl_env) @@ -403,14 +403,14 @@ the @SrcSpan@ being carried around. getGhcModeDs :: DsM GhcMode getGhcModeDs = getDynFlags >>= return . ghcMode --- | Get the current pattern match oracle state. See 'dsl_deltas'. -getPmDeltas :: DsM Deltas -getPmDeltas = do { env <- getLclEnv; return (dsl_deltas env) } +-- | Get the current pattern match oracle state. See 'dsl_nablas'. +getPmNablas :: DsM Nablas +getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } -- | Set the pattern match oracle state within the scope of the given action. --- See 'dsl_deltas'. -updPmDeltas :: Deltas -> DsM a -> DsM a -updPmDeltas deltas = updLclEnv (\env -> env { dsl_deltas = deltas }) +-- See 'dsl_nablas'. +updPmNablas :: Nablas -> DsM a -> DsM a +updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -28,14 +28,14 @@ -- a. The set of uncovered values, 'cr_uncov' -- b. And an annotated tree variant (like 'AnnMatch') that captures -- redundancy and inaccessibility information as 'RedSets' annotations --- Basically the UA function from Section 5.1. The Normalised Refinement Types --- Nabla are modeled as 'Deltas' and checked in "GHC.HsToCore.PmCheck.Oracle". +-- Basically the UA function from Section 5.1. The Normalised Refinement +-- Types 'Nablas' are maintained in "GHC.HsToCore.PmCheck.Oracle". -- 3. Collect redundancy information into a 'CIRB' with a 'CIRBCollector' such -- as 'collectMatch'. Follows the R function from Figure 6 of the paper. -- 4. Format and report uncovered patterns and redundant equations ('CIRB') -- with 'formatReportWarnings'. Basically job of the G function, plus proper -- pretty printing of the warnings (Section 5.4 of the paper). --- 5. Return 'Deltas' reaching syntactic sub-components for +-- 5. Return 'Nablas' reaching syntactic sub-components for -- Note [Long-distance information]. See Section 4.1 of the paper. module GHC.HsToCore.PmCheck ( -- Checking and printing @@ -68,7 +68,6 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Core.DataCon -import GHC.Core.TyCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper) @@ -103,7 +102,7 @@ import Data.Coerce covCheckPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [covCheckPatBind only checks PatBindRhs] covCheckPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do - missing <- getPmDeltas + missing <- getPmNablas pat_bind <- desugarPatBind loc var p tracePm "covCheckPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result <- unCA (checkPatBind pat_bind) missing @@ -112,17 +111,17 @@ covCheckPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do covCheckPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and --- in @MultiIf@ expressions. Returns the 'Deltas' covered by the RHSs. +-- in @MultiIf@ expressions. Returns the 'Nablas' covered by the RHSs. covCheckGRHSs :: HsMatchContext GhcRn -- ^ Match context, for warning messages -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check - -> DsM (NonEmpty Deltas) -- ^ Covered 'Deltas' for each RHS, for long + -> DsM (NonEmpty Nablas) -- ^ Covered 'Nablas' for each RHS, for long -- distance info covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do let combined_loc = foldl1 combineSrcSpans (map getLoc grhss) ctxt = DsMatchContext hs_ctxt combined_loc matches <- desugarGRHSs combined_loc empty guards - missing <- getPmDeltas + missing <- getPmNablas tracePm "covCheckGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -140,7 +139,7 @@ covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- f _ _ = 3 -- clause with a single, un-guarded RHS -- @ -- --- Returns one non-empty 'Deltas' for 1.) each pattern of a 'Match' and 2.) +-- Returns one non-empty 'Nablas' for 1.) each pattern of a 'Match' and 2.) -- each of a 'Match'es 'GRHS' for Note [Long-distance information]. -- -- Special case: When there are /no matches/, then the functionassumes it @@ -150,13 +149,13 @@ covCheckMatches :: DsMatchContext -- ^ Match context, for warnings messages -> [Id] -- ^ Match variables, i.e. x and y above -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches - -> DsM [(Deltas, NonEmpty Deltas)] -- ^ One covered 'Deltas' per Match and + -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and -- GRHS, for long distance info. covCheckMatches ctxt vars matches = do -- We have to force @missing@ before printing out the trace message, -- otherwise we get interleaved output from the solver. This function -- should be strict in @missing@ anyway! - !missing <- getPmDeltas + !missing <- getPmNablas tracePm "covCheckMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 @@ -207,7 +206,7 @@ exception into divergence (@f x = f x@). Semantically, unlike every other case expression, -XEmptyCase is strict in its match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the -initial Delta and check if there are any values left to match on. +initial Nabla and check if there are any values left to match on. -} -- @@ -233,8 +232,8 @@ data PmGrd -- bang pattern, in which case we might want to report it as redundant. -- See Note [Dead bang patterns]. | PmBang { - pm_id :: !Id, - pm_loc :: !(Maybe SrcInfo) + pm_id :: !Id, + _pm_loc :: !(Maybe SrcInfo) } -- | @PmLet x expr@ corresponds to a @let x = expr@ guard. This actually @@ -298,15 +297,15 @@ newtype GrdPatBind = -- (later digested into a 'CIRB'). data RedSets = RedSets - { rs_cov :: !Deltas + { rs_cov :: !Nablas -- ^ The /Covered/ set; the set of values reaching a particular program -- point. - , rs_div :: !Deltas + , rs_div :: !Nablas -- ^ The /Diverging/ set; empty if no match can lead to divergence. -- If it wasn't empty, we have to turn redundancy warnings into -- inaccessibility warnings for any subclauses. - , rs_bangs :: !(OrdList (Deltas, SrcInfo)) - -- ^ If any of the 'Deltas' is empty, the corresponding 'SrcInfo' pin-points + , rs_bangs :: !(OrdList (Nablas, SrcInfo)) + -- ^ If any of the 'Nablas' is empty, the corresponding 'SrcInfo' pin-points -- a bang pattern in source that is redundant. See Note [Dead bang patterns]. } @@ -434,7 +433,7 @@ vanillaConGrd scrut con arg_ids = -- For example: -- @mkListGrds "a" "[(x, True <- x),(y, !y)]"@ -- to --- @"[(x:b) <- a, True <- x, (y:c) <- b, seq y True, [] <- c]"@ +-- @"[(x:b) <- a, True <- x, (y:c) <- b, !y, [] <- c]"@ -- where @b@ and @c@ are freshly allocated in @mkListGrds@ and @a@ is the match -- variable. mkListGrds :: Id -> [(Id, GrdVec)] -> DsM GrdVec @@ -618,7 +617,7 @@ desugarListPat x pats = do -- | Desugar a constructor pattern desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar] - -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdVec + -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdVec desugarConPatOut x con univ_tys ex_tvs dicts = \case PrefixCon ps -> go_field_pats (zip [0..] ps) InfixCon p1 p2 -> go_field_pats (zip [0..] [p1,p2]) @@ -638,14 +637,14 @@ desugarConPatOut x con univ_tys ex_tvs dicts = \case lbl_to_index lbl = expectJust "lbl_to_index" $ elemIndex lbl orig_lbls go_field_pats tagged_pats = do - -- The fields that appear might not be in the correct order. So first - -- do a PmCon match, then force according to field strictness and then - -- force evaluation of the field patterns in the order given by - -- the first field of @tagged_pats at . + -- The fields that appear might not be in the correct order. So + -- 1. Do the PmCon match + -- 2. Then pattern match on the fields in the order given by the first + -- field of @tagged_pats at . -- See Note [Field match order for RecCon] -- Desugar the mentioned field patterns. We're doing this first to get - -- the Ids for pm_con_args. + -- the Ids for pm_con_args and bring them in order afterwards. let trans_pat (n, pat) = do (var, pvec) <- desugarLPatV pat pure ((n, var), pvec) @@ -659,19 +658,11 @@ desugarConPatOut x con univ_tys ex_tvs dicts = \case arg_ids <- zipWithM get_pat_id [0..] arg_tys let con_grd = PmCon x (PmAltConLike con) ex_tvs dicts arg_ids - -- 2. bang strict fields - let arg_is_banged = map isBanged $ conLikeImplBangs con - noSrcPmBang i = PmBang {pm_id = i, pm_loc = Nothing} - bang_grds = map noSrcPmBang (filterByList arg_is_banged arg_ids) - - -- 3. guards from field selector patterns + -- 2. guards from field selector patterns let arg_grds = concat arg_grdss -- tracePm "ConPatOut" (ppr x $$ ppr con $$ ppr arg_ids) - -- - -- Store the guards in exactly that order - -- 1. 2. 3. - pure (con_grd : bang_grds ++ arg_grds) + pure (con_grd : arg_grds) desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM GrdPatBind -- See 'GrdPatBind' for how this simply repurposes GrdGRHS. @@ -759,30 +750,45 @@ desugarBoolGuard e -> pure [vanillaConGrd y trueDataCon []] rhs -> do x <- mkPmId boolTy - pure $ [PmLet x rhs, vanillaConGrd x trueDataCon []] + pure [PmLet x rhs, vanillaConGrd x trueDataCon []] {- Note [Field match order for RecCon] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The order for RecCon field patterns actually determines evaluation order of the pattern match. For example: - data T = T { a :: !Bool, b :: Char, c :: Int } + data T = T { a :: Char, b :: Int } f :: T -> () - f T{ c = 42, b = 'b' } = () + f T{ b = 42, a = 'a' } = () + +Then @f (T (error "a") (error "b"))@ errors out with "b" because it is mentioned +first in the pattern match. -Then - * @f (T (error "a") (error "b") (error "c"))@ errors out with "a" because of - the strict field. - * @f (T True (error "b") (error "c"))@ errors out with "c" because it - is mentioned frist in the pattern match. +This means we can't just desugar the pattern match to +@[T a b <- x, 'a' <- a, 42 <- b]@. Instead we have to force them in the +right order: @[T a b <- x, 42 <- b, 'a' <- a]@. -This means we can't just desugar the pattern match to the PatVec -@[T !_ 'b' 42]@. Instead we have to generate variable matches that have -strictness according to the field declarations and afterwards force them in the -right order. As a result, we get the PatVec @[T !_ b c, 42 <- c, 'b' <- b]@. +Note [Strict fields and fields of unlifted type] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +How do strict fields play into Note [Field match order for RecCon]? Answer: +They don't. Desugaring is entirely unconcerned by strict fields; the forcing +happens *before* pattern matching. But for each strict (or more generally, +unlifted) field @s@ we have to add @s /~ ⊥@ constraints when we check the PmCon +guard in 'checkGrd'. Strict fields are devoid of ⊥ by construction, there's +nothing that a bang pattern would act on. Example from #18341: + + data T = MkT !Int + f :: T -> () + f (MkT _) | False = () -- inaccessible + f (MkT !_) | False = () -- redundant, not only inaccessible! + f _ = () -Of course, when the labels occur in the order they are defined, we can just use -the simpler desugaring. +The second clause desugars to @MkT n <- x, !n at . When coverage checked, the +'PmCon' @MkT n <- x@ refines the set of values that reach the bang pattern with +the constraints @x ~ MkT n, n /~ ⊥@ (this list is computed by 'pmConCts'). +Checking the 'PmBang' @!n@ will then try to add the constraint @n ~ ⊥@ to this +set to get the diverging set, which is found to be empty. Hence the whole +clause is detected as redundant, as expected. Note [Order of guards matters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -834,7 +840,7 @@ data CheckResult a = CheckResult { cr_ret :: !a -- ^ A hole for redundancy info and covered sets. - , cr_uncov :: !Deltas + , cr_uncov :: !Nablas -- ^ The set of uncovered values falling out at the bottom. -- (for -Wincomplete-patterns, but also important state for the algorithm) , cr_approx :: !Precision @@ -852,23 +858,23 @@ instance Outputable a => Outputable (CheckResult a) where ppr_precision Approximate = text "(Approximate)" field name value = text name <+> equals <+> ppr value --- | Lift 'addPmCts' over 'Deltas'. -addPmCtsDeltas :: Deltas -> PmCts -> DsM Deltas -addPmCtsDeltas deltas cts = liftDeltasM (\d -> addPmCts d cts) deltas +-- | Lift 'addPmCts' over 'Nablas'. +addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas +addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas --- | 'addPmCtsDeltas' for a single 'PmCt'. -addPmCtDeltas :: Deltas -> PmCt -> DsM Deltas -addPmCtDeltas deltas ct = addPmCtsDeltas deltas (unitBag ct) +-- | 'addPmCtsNablas' for a single 'PmCt'. +addPmCtNablas :: Nablas -> PmCt -> DsM Nablas +addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) --- | Test if any of the 'Delta's is inhabited. Currently this is pure, because --- we preserve the invariant that there are no uninhabited 'Delta's. But that +-- | Test if any of the 'Nabla's is inhabited. Currently this is pure, because +-- we preserve the invariant that there are no uninhabited 'Nabla's. But that -- could change in the future, for example by implementing this function in -- terms of @notNull <$> provideEvidence 1 ds at . -isInhabited :: Deltas -> DsM Bool -isInhabited (MkDeltas ds) = pure (not (null ds)) +isInhabited :: Nablas -> DsM Bool +isInhabited (MkNablas ds) = pure (not (null ds)) -- | Coverage checking action. Can be composed 'leftToRight' or 'topToBottom'. -newtype CheckAction a = CA { unCA :: Deltas -> DsM (CheckResult a) } +newtype CheckAction a = CA { unCA :: Nablas -> DsM (CheckResult a) } deriving Functor -- | Composes 'CheckAction's top-to-bottom: @@ -910,23 +916,34 @@ leftToRight f (CA left) (CA right) = CA $ \inc -> do , cr_uncov = uncov' , cr_approx = prec' Semi.<> cr_approx l Semi.<> cr_approx r } --- | @throttle limit old new@ returns @old@ if the number of 'Delta's in @new@ --- is exceeding the given @limit@ and the @old@ number of 'Delta's. +-- | @throttle limit old new@ returns @old@ if the number of 'Nabla's in @new@ +-- is exceeding the given @limit@ and the @old@ number of 'Nabla's. -- See Note [Countering exponential blowup]. -throttle :: Int -> Deltas -> Deltas -> (Precision, Deltas) -throttle limit old@(MkDeltas old_ds) new@(MkDeltas new_ds) +throttle :: Int -> Nablas -> Nablas -> (Precision, Nablas) +throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) --- | pprTrace "PmCheck:throttle" (ppr (length old_ds) <+> ppr (length new_ds) <+> ppr limit) False = undefined | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | Matching on a newtype doesn't force anything. --- See Note [Divergence of Newtype matches] in "GHC.HsToCore.PmCheck.Oracle". -conMatchForces :: PmAltCon -> Bool -conMatchForces (PmAltConLike (RealDataCon dc)) - | isNewTyCon (dataConTyCon dc) = False -conMatchForces _ = True - --- First the functions that correspond to checking LYG primitives: +-- | The 'PmCts' arising from a successful 'PmCon' match @T gammas as ys <- x at . +-- These include +-- +-- * @gammas@: Constraints arising from the bound evidence vars +-- * @y /~ ⊥@ constraints for each unlifted field (including strict fields) +-- @y@ in @ys@ +-- * The constructor constraint itself: @x ~ T as ys at . +-- +-- See Note [Strict fields and fields of unlifted type]. +pmConCts :: Id -> PmAltCon -> [TyVar] -> [EvVar] -> [Id] -> PmCts +pmConCts x con tvs dicts args = gammas `unionBags` unlifted `snocBag` con_ct + where + gammas = listToBag $ map (PmTyCt . evVarPred) dicts + con_ct = PmConCt x con tvs args + unlifted = listToBag [ PmNotBotCt arg + | (arg, bang) <- + zipEqual "pmConCts" args (pmAltConImplBangs con) + , isBanged bang || isUnliftedType (idType arg) + ] checkSequence :: (grdtree -> CheckAction anntree) -> NonEmpty grdtree -> CheckAction (NonEmpty anntree) -- The implementation is pretty similar to @@ -939,31 +956,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtDeltas inc (PmCoreCt x e) + matched <- addPmCtNablas inc (PmCoreCt x e) + -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x /~ ⊥ PmBang x mb_info -> do - div <- addPmCtDeltas inc (PmBotCt x) - matched <- addPmCtDeltas inc (PmNotBotCt x) + div <- addPmCtNablas inc (PmBotCt x) + matched <- addPmCtNablas inc (PmNotBotCt x) -- See Note [Dead bang patterns] -- mb_info = Just info <==> PmBang originates from bang pattern in source let bangs | Just info <- mb_info = unitOL (div, info) | otherwise = NilOL + -- tracePm "check:Bang" (ppr x <+> ppr div) pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } , cr_uncov = mempty , cr_approx = Precise } - -- Con: Diverge on x ~ ⊥, fall through on x /~ K and refine with x ~ K ys - -- and type info + -- Con: Fall through on x /~ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do - div <- if conMatchForces con - then addPmCtDeltas inc (PmBotCt x) + !div <- if isPmAltConMatchStrict con + then addPmCtNablas inc (PmBotCt x) else pure mempty - uncov <- addPmCtDeltas inc (PmNotConCt x con) - matched <- addPmCtsDeltas inc $ - listToBag (PmTyCt . evVarPred <$> dicts) `snocBag` PmConCt x con tvs args - -- tracePm "checkGrd:Con" (ppr inc $$ ppr x $$ ppr con $$ ppr dicts $$ ppr matched) + let con_cts = pmConCts x con tvs dicts args + !matched <- addPmCtsNablas inc con_cts + !uncov <- addPmCtNablas inc (PmNotConCt x con) + -- tracePm "checkGrd:Con" (ppr inc $$ ppr grd $$ ppr con_cts $$ ppr matched) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -997,7 +1015,7 @@ checkGRHS (GrdGRHS { gg_grds = grds, gg_rhs = rhs_info }) = checkEmptyCase :: GrdEmptyCase -> CheckAction AnnEmptyCase checkEmptyCase (GrdEmptyCase { ge_var = var }) = CA $ \inc -> do - unc <- addPmCtDeltas inc (PmNotBotCt var) + unc <- addPmCtNablas inc (PmNotBotCt var) pure CheckResult { cr_ret = AnnEmptyCase, cr_uncov = unc, cr_approx = mempty } checkPatBind :: GrdPatBind -> CheckAction AnnPatBind @@ -1007,7 +1025,7 @@ checkPatBind = coerce checkGRHS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Precise pattern match exhaustiveness checking is necessarily exponential in the size of some input programs. We implement a counter-measure in the form of -the -fmax-pmcheck-models flag, limiting the number of Deltas we check against +the -fmax-pmcheck-models flag, limiting the number of Nablas we check against each pattern by a constant. How do we do that? Consider @@ -1016,13 +1034,13 @@ How do we do that? Consider f True True = () And imagine we set our limit to 1 for the sake of the example. The first clause -will be checked against the initial Delta, {}. Doing so will produce an +will be checked against the initial Nabla, {}. Doing so will produce an Uncovered set of size 2, containing the models {x/~True} and {x~True,y/~True}. Also we find the first clause to cover the model {x~True,y~True}. But the Uncovered set we get out of the match is too huge! We somehow have to ensure not to make things worse as they are already, so we continue checking -with a singleton Uncovered set of the initial Delta {}. Why is this +with a singleton Uncovered set of the initial Nabla {}. Why is this sound (wrt. the notion in GADTs Meet Their Match)? Well, it basically amounts to forgetting that we matched against the first clause. The values represented by {} are a superset of those represented by its two refinements {x/~True} and @@ -1093,41 +1111,41 @@ addRedundantBangs red_bangs cirb = -- 1. A 'CIRB', classifying every encountered RHS in the tree as -- redundant, inaccessible or covered. -- 2. A piece of long-distance information @ldi@, consisting of a --- nesting of 'Deltas' mirroring tree structure. +-- nesting of 'Nablas' mirroring tree structure. -- For example, 'collectMatchGroup' operates on a Match Group and thus --- returns a list of 'Deltas' for the pattern part of each Match, as well as --- a further nested list of 'Deltas' for each of the GRHS of the Match. +-- returns a list of 'Nablas' for the pattern part of each Match, as well as +-- a further nested list of 'Nablas' for each of the GRHS of the Match. type CIRBCollector ann ldi = ann -> DsM (CIRB, ldi) --- | Checks the 'Deltas' in a 'RedSets' for inhabitants and returns +-- | Checks the 'Nablas' in a 'RedSets' for inhabitants and returns -- 1. Whether the Covered set was inhabited -- 2. Whether the Diverging set was inhabited -- 3. The new inhabited Covered set for long-distance information. -- See Note [Recovering from unsatisfiable pattern-matching constraints]. --- 4. All source bangs whose 'Deltas' were empty, which means they are +-- 4. All source bangs whose 'Nablas' were empty, which means they are -- redundant. -testRedSets :: Deltas -> RedSets -> DsM (Bool, Bool, Deltas, OrdList SrcInfo) +testRedSets :: Nablas -> RedSets -> DsM (Bool, Bool, Nablas, OrdList SrcInfo) testRedSets ldi RedSets { rs_cov = cov, rs_div = div, rs_bangs = bangs } = do is_covered <- isInhabited cov may_diverge <- isInhabited div - red_bangs <- flip mapMaybeM (fromOL bangs) $ \(deltas, bang) -> do - isInhabited deltas >>= \case + red_bangs <- flip mapMaybeM (fromOL bangs) $ \(nablas, bang) -> do + isInhabited nablas >>= \case True -> pure Nothing False -> pure (Just bang) -- See Note [Recovering from unsatisfiable pattern-matching constraints] - -- Deltas for long-distance info: Use (non-empty!) fallback ldi if Covered + -- Nablas for long-distance info: Use (non-empty!) fallback ldi if Covered -- set was empty let ldi' | is_covered = cov | otherwise = ldi pure (is_covered, may_diverge, ldi', toOL red_bangs) -collectMatchGroup :: Deltas -> CIRBCollector AnnMatchGroup (NonEmpty (Deltas, NonEmpty Deltas)) +collectMatchGroup :: Nablas -> CIRBCollector AnnMatchGroup (NonEmpty (Nablas, NonEmpty Nablas)) collectMatchGroup ldi (AnnMatchGroup matches) = do (cirbs, ldis) <- NE.unzip <$> traverse (collectMatch ldi) matches pure (Semi.sconcat cirbs, ldis) -collectMatch :: Deltas -> CIRBCollector AnnMatch (Deltas, NonEmpty Deltas) +collectMatch :: Nablas -> CIRBCollector AnnMatch (Nablas, NonEmpty Nablas) collectMatch ldi AnnMatch { am_red = red, am_grhss = grhss } = do (is_covered, may_diverge, ldi', red_bangs) <- testRedSets ldi red (cirb, ldis) <- collectGRHSs ldi' grhss @@ -1138,12 +1156,12 @@ collectMatch ldi AnnMatch { am_red = red, am_grhss = grhss } = do $ cirb pure (cirb', (ldi', ldis)) -collectGRHSs :: Deltas -> CIRBCollector (NonEmpty AnnGRHS) (NonEmpty Deltas) +collectGRHSs :: Nablas -> CIRBCollector (NonEmpty AnnGRHS) (NonEmpty Nablas) collectGRHSs ldi grhss = do (cirbs, ldis) <- NE.unzip <$> traverse (collectGRHS ldi) grhss pure (Semi.sconcat cirbs, ldis) -collectGRHS :: Deltas -> CIRBCollector AnnGRHS Deltas +collectGRHS :: Nablas -> CIRBCollector AnnGRHS Nablas collectGRHS ldi AnnGRHS { ag_red = red, ag_rhs = info } = do (is_covered, may_diverge, ldi', red_bangs) <- testRedSets ldi red let cirb | is_covered = mempty { cirb_cov = unitOL info } @@ -1156,9 +1174,9 @@ collectEmptyCase _ = pure (mempty, ()) collectPatBind :: CIRBCollector AnnPatBind () -- We don't make use of long-distance information in pattern bindings, hence --- @()@ instead of some 'Deltas'. +-- @()@ instead of some 'Nablas'. collectPatBind (AnnPatBind grhs) = do - -- use 'mempty' as fallback 'Deltas' because we discard it anyway + -- use 'mempty' as fallback 'Nablas' because we discard it anyway (cirb, _) <- collectGRHS mempty grhs pure (cirb, ()) @@ -1236,10 +1254,10 @@ reportWarnings dflags ctx@(DsMatchContext kind loc) vars f (q <+> matchSeparator kind <+> text "...") -- Print several clauses (for uncovered clauses) - pprEqns vars deltas = pprContext False ctx (text "are non-exhaustive") $ \_ -> + pprEqns vars nablas = pprContext False ctx (text "are non-exhaustive") $ \_ -> case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" - _ -> let us = map (\delta -> pprUncovered delta vars) deltas + _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas in hang (text "Patterns not matched:") 4 (vcat (take maxPatterns us) $$ dots maxPatterns us) @@ -1254,14 +1272,14 @@ reportWarnings dflags ctx@(DsMatchContext kind loc) vars $$ bullet <+> text "Patterns reported as unmatched might actually be matched") , text "Increase the limit or resolve the warnings to suppress this message." ] -getNFirstUncovered :: [Id] -> Int -> Deltas -> DsM [Delta] -getNFirstUncovered vars n (MkDeltas deltas) = go n (bagToList deltas) +getNFirstUncovered :: [Id] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] go _ [] = pure [] - go n (delta:deltas) = do - front <- provideEvidence vars n delta - back <- go (n - length front) deltas + go n (nabla:nablas) = do + front <- provideEvidence vars n nabla + back <- go (n - length front) nablas pure (front ++ back) dots :: Int -> [a] -> SDoc @@ -1386,21 +1404,21 @@ code that we don't want to warn about. -- * Long-distance information -- --- | Locally update 'dsl_deltas' with the given action, but defer evaluation +-- | Locally update 'dsl_nablas' with the given action, but defer evaluation -- with 'unsafeInterleaveM' in order not to do unnecessary work. -locallyExtendPmDeltas :: (Deltas -> DsM Deltas) -> DsM a -> DsM a -locallyExtendPmDeltas ext k = do - deltas <- getPmDeltas - deltas' <- unsafeInterleaveM $ do - deltas' <- ext deltas - inh <- isInhabited deltas' +locallyExtendPmNablas :: (Nablas -> DsM Nablas) -> DsM a -> DsM a +locallyExtendPmNablas ext k = do + nablas <- getPmNablas + nablas' <- unsafeInterleaveM $ do + nablas' <- ext nablas + inh <- isInhabited nablas' -- If adding a constraint would lead to a contradiction, don't add it. -- See Note [Recovering from unsatisfiable pattern-matching constraints] -- for why this is done. if inh - then pure deltas' - else pure deltas - updPmDeltas deltas' k + then pure nablas' + else pure nablas + updPmNablas nablas' k -- | Add in-scope type constraints if the coverage checker might run and then -- run the given action. @@ -1408,7 +1426,7 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmDeltas (\deltas -> addPmCtsDeltas deltas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1419,8 +1437,8 @@ addTyCs origin ev_vars m = do addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = - flip locallyExtendPmDeltas k $ \deltas -> - addPmCtsDeltas deltas (unitBag (PmCoreCt x scr)) + flip locallyExtendPmNablas k $ \nablas -> + addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. @@ -1448,10 +1466,10 @@ of @f at . To achieve similar reasoning in the coverage checker, we keep track of the set of values that can reach a particular program point (often loosely referred to -as "Covered set") in 'GHC.HsToCore.Monad.dsl_deltas'. -We fill that set with Covered Deltas returned by the exported checking +as "Covered set") in 'GHC.HsToCore.Monad.dsl_nablas'. +We fill that set with Covered Nablas returned by the exported checking functions, which the call sites put into place with -'GHC.HsToCore.Monad.updPmDeltas'. +'GHC.HsToCore.Monad.updPmNablas'. Call sites also extend this set with facts from type-constraint dictionaries, case scrutinees, etc. with the exported functions 'addTyCs', 'addCoreScrutTmCs' and 'addHsScrutTmCs'. @@ -1472,9 +1490,9 @@ unreachable. We can do better than this, by making sure that the Covered set used for Note [Long-distance information] is always inhabited. For Covered sets returned by the exported checking functions, that is ensured -in 'testRedSets', which takes and returns a non-empty fallback 'Deltas' in case +in 'testRedSets', which takes and returns a non-empty fallback 'Nablas' in case the refined Covered set became uninhabited. Also, whenever "external" knowledge from a type constraint or case scrutinee is -integrated, we only commit that knowledge to 'GHC.HsToCore.Monad.dsl_deltas' if -the set remains inhabited. That check happens in 'locallyExtendPmDeltas'. +integrated, we only commit that knowledge to 'GHC.HsToCore.Monad.dsl_nablas' if +the set remains inhabited. That check happens in 'locallyExtendPmNablas'. -} ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -4,22 +4,25 @@ Authors: George Karachalias Ryan Scott -} -{-# LANGUAGE CPP, LambdaCase, TupleSections, PatternSynonyms, ViewPatterns, MultiWayIf #-} +{-# LANGUAGE CPP, LambdaCase, TupleSections, PatternSynonyms, ViewPatterns, MultiWayIf, ScopedTypeVariables #-} -- | The pattern match oracle. The main export of the module are the functions -- 'addPmCts' for adding facts to the oracle, and 'provideEvidence' to turn a --- 'Delta' into a concrete evidence for an equation. +-- 'Nabla' into a concrete evidence for an equation. +-- +-- In terms of the [Lower Your Guards paper](https://dl.acm.org/doi/abs/10.1145/3408989) +-- describing the implementation, this module is concerned with Sections 3.4, 3.6 and 3.7. +-- E.g., it represents refinement types diretly as a normalised refinement type 'Nabla'. module GHC.HsToCore.PmCheck.Oracle ( DsM, tracePm, mkPmId, - Delta, initDeltas, lookupRefuts, lookupSolution, + Nabla, initNablas, lookupRefuts, lookupSolution, PmCt(PmTyCt), PmCts, pattern PmVarCt, pattern PmCoreCt, pattern PmConCt, pattern PmNotConCt, pattern PmBotCt, pattern PmNotBotCt, addPmCts, -- Add a constraint to the oracle. - canDiverge, -- Try to add the term equality x ~ ⊥ provideEvidence ) where @@ -153,12 +156,7 @@ mkOneConFull arg_tys con = do -- to the type oracle let ty_cs = substTheta subst (eqSpecPreds eq_spec ++ thetas) -- Figure out the types of strict constructor fields - let arg_is_strict - | RealDataCon dc <- con - , isNewTyCon (dataConTyCon dc) - = [True] -- See Note [Divergence of Newtype matches] - | otherwise - = map isBanged $ conLikeImplBangs con + let arg_is_strict = map isBanged $ conLikeImplBangs con strict_arg_tys = filterByList arg_is_strict field_tys' return (ex_tvs, vars, listToBag ty_cs, strict_arg_tys) @@ -169,8 +167,8 @@ mkOneConFull arg_tys con = do ------------------------------------- -- * Composable satisfiability checks --- | Given a 'Delta', check if it is compatible with new facts encoded in this --- this check. If so, return 'Just' a potentially extended 'Delta'. Return +-- | Given a 'Nabla', check if it is compatible with new facts encoded in this +-- this check. If so, return 'Just' a potentially extended 'Nabla'. Return -- 'Nothing' if unsatisfiable. -- -- There are three essential SatisfiabilityChecks: @@ -179,22 +177,22 @@ mkOneConFull arg_tys con = do -- 3. 'tysAreNonVoid', checks if the given types have an inhabitant -- Functions like 'pmIsSatisfiable', 'nonVoid' and 'testInhabited' plug these -- together as they see fit. -newtype SatisfiabilityCheck = SC (Delta -> DsM (Maybe Delta)) +newtype SatisfiabilityCheck = SC (Nabla -> DsM (Maybe Nabla)) --- | Check the given 'Delta' for satisfiability by the given --- 'SatisfiabilityCheck'. Return 'Just' a new, potentially extended, 'Delta' if +-- | Check the given 'Nabla' for satisfiability by the given +-- 'SatisfiabilityCheck'. Return 'Just' a new, potentially extended, 'Nabla' if -- successful, and 'Nothing' otherwise. -runSatisfiabilityCheck :: Delta -> SatisfiabilityCheck -> DsM (Maybe Delta) -runSatisfiabilityCheck delta (SC chk) = chk delta +runSatisfiabilityCheck :: Nabla -> SatisfiabilityCheck -> DsM (Maybe Nabla) +runSatisfiabilityCheck nabla (SC chk) = chk nabla -- | Allowing easy composition of 'SatisfiabilityCheck's. instance Semigroup SatisfiabilityCheck where -- This is @a >=> b@ from MaybeT DsM SC a <> SC b = SC c where - c delta = a delta >>= \case + c nabla = a nabla >>= \case Nothing -> pure Nothing - Just delta' -> b delta' + Just nabla' -> b nabla' instance Monoid SatisfiabilityCheck where -- We only need this because of mconcat (which we use in place of sconcat, @@ -213,13 +211,13 @@ instance Monoid SatisfiabilityCheck where -- discussed in GADTs Meet Their Match. For an explanation of what role they -- serve, see @Note [Strict argument type constraints]@. pmIsSatisfiable - :: Delta -- ^ The ambient term and type constraints + :: Nabla -- ^ The ambient term and type constraints -- (known to be satisfiable). -> Bag TyCt -- ^ The new type constraints. -> Bag TmCt -- ^ The new term constraints. -> [Type] -- ^ The strict argument types. - -> DsM (Maybe Delta) - -- ^ @'Just' delta@ if the constraints (@delta@) are + -> DsM (Maybe Nabla) + -- ^ @'Just' nabla@ if the constraints (@nabla@) are -- satisfiable, and each strict argument type is inhabitable. -- 'Nothing' otherwise. pmIsSatisfiable amb_cs new_ty_cs new_tm_cs strict_arg_tys = @@ -492,21 +490,21 @@ tyOracle (TySt inert) cts Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } -- | A 'SatisfiabilityCheck' based on new type-level constraints. --- Returns a new 'Delta' if the new constraints are compatible with existing +-- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. Doesn't bother calling out to the type oracle if the bag of new type -- constraints was empty. Will only recheck 'PossibleMatches' in the term oracle -- for emptiness if the first argument is 'True'. tyIsSatisfiable :: Bool -> Bag PredType -> SatisfiabilityCheck -tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \delta -> +tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \nabla -> if isEmptyBag new_ty_cs - then pure (Just delta) - else tyOracle (delta_ty_st delta) new_ty_cs >>= \case + then pure (Just nabla) + else tyOracle (nabla_ty_st nabla) new_ty_cs >>= \case Nothing -> pure Nothing Just ty_st' -> do - let delta' = delta{ delta_ty_st = ty_st' } + let nabla' = nabla{ nabla_ty_st = ty_st' } if recheck_complete_sets - then ensureAllPossibleMatchesInhabited delta' - else pure (Just delta') + then ensureAllInhabited nabla' + else pure (Just nabla') {- ********************************************************************* @@ -618,21 +616,46 @@ warning messages (which can be alleviated by someone with enough dedication). -} -- | A 'SatisfiabilityCheck' based on new term-level constraints. --- Returns a new 'Delta' if the new constraints are compatible with existing +-- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. tmIsSatisfiable :: Bag TmCt -> SatisfiabilityCheck -tmIsSatisfiable new_tm_cs = SC $ \delta -> runMaybeT $ foldlM addTmCt delta new_tm_cs +tmIsSatisfiable new_tm_cs = SC $ \nabla -> runMaybeT $ foldlM addTmCt nabla new_tm_cs ----------------------- -- * Looking up VarInfo emptyVarInfo :: Id -> VarInfo -emptyVarInfo x = VI (idType x) [] emptyPmAltConSet NoPM +-- We could initialise @bot@ to @Just False@ in case of an unlifted type here, +-- but it's cleaner to let the user of the constraint solver take care of this. +-- After all, there are also strict fields, the unliftedness of which isn't +-- evident in the type. So treating unlifted types here would never be +-- sufficient anyway. +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot NoPM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' lookupVarInfo (TmSt env _) x = fromMaybe (emptyVarInfo x) (lookupSDIE env x) +-- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks +-- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the +-- returned @y@ doesn't have a positive newtype constructor constraint +-- associated with it (yet). The 'VarInfo' returned is that of @y@'s +-- representative. +-- +-- Careful, this means that @idType x@ might be different to @idType y@, even +-- modulo type normalisation! +-- +-- See also Note [Coverage checking Newtype matches]. +lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +lookupVarInfoNT ts x = case lookupVarInfo ts x of + VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y + res -> (x, res) + where + as_newtype = listToMaybe . mapMaybe go + go (PmAltConLike (RealDataCon dc), _, [y]) + | isNewDataCon dc = Just y + go _ = Nothing + initPossibleMatches :: TyState -> VarInfo -> DsM VarInfo initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do -- New evidence might lead to refined info on ty, in turn leading to discovery @@ -669,13 +692,6 @@ initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do Just cs -> pure vi{ vi_ty = ty', vi_cache = PM (mkUniqDSet <$> cs) } initPossibleMatches _ vi = pure vi --- | @initLookupVarInfo ts x@ looks up the 'VarInfo' for @x@ in @ts@ and tries --- to initialise the 'vi_cache' component if it was 'NoPM' through --- 'initPossibleMatches'. -initLookupVarInfo :: Delta -> Id -> DsM VarInfo -initLookupVarInfo MkDelta{ delta_tm_st = ts, delta_ty_st = ty_st } x - = initPossibleMatches ty_st (lookupVarInfo ts x) - {- Note [COMPLETE sets on data families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ User-defined COMPLETE sets involving data families are attached to the family @@ -720,22 +736,11 @@ TyCon, so tc_rep = tc_fam afterwards. -} ------------------------------------------------ --- * Exported utility functions querying 'Delta' +-- * Exported utility functions querying 'Nabla' --- | Check whether adding a constraint @x ~ BOT@ to 'Delta' succeeds. -canDiverge :: Delta -> Id -> Bool -canDiverge delta at MkDelta{ delta_tm_st = ts } x - | VI _ pos neg _ <- lookupVarInfo ts x - = isEmptyPmAltConSet neg && all pos_can_diverge pos - where - pos_can_diverge (PmAltConLike (RealDataCon dc), _, [y]) - -- See Note [Divergence of Newtype matches] - | isNewTyCon (dataConTyCon dc) = canDiverge delta y - pos_can_diverge _ = False - -{- Note [Divergence of Newtype matches] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Newtypes behave rather strangely when compared to ordinary DataCons. In a +{- Note [Coverage checking Newtype matches] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Newtypes have quite peculiar match semantics compared to ordinary DataCons. In a pattern-match, they behave like a irrefutable (lazy) match, but for inhabitation testing purposes (e.g. at construction sites), they behave rather like a DataCon with a *strict* field, because they don't contribute their own bottom and are @@ -750,19 +755,21 @@ This distinction becomes apparent in #17248: If we treat Newtypes like we treat regular DataCons, we would mark the third clause as redundant, which clearly is unsound. The solution: -1. When compiling the PmCon guard in 'pmCompileTree', don't add a @DivergeIf@, - because the match will never diverge. -2. Regard @T2 x@ as 'canDiverge' iff @x@ 'canDiverge'. E.g. @T2 x ~ _|_@ <=> - @x ~ _|_ at . This way, the third clause will still be marked as inaccessible - RHS instead of redundant. -3. When testing for inhabitants ('mkOneConFull'), we regard the newtype field as - strict, so that the newtype is inhabited iff its field is inhabited. +1. 'isPmAltConMatchStrict' returns False for newtypes, indicating that a + newtype match is lazy. +2. When we find @x ~ T2 y@, transfer all constraints on @x@ (which involve @⊥@) + to @y@, similar to what 'equate' does, and don't add a @x /~ ⊥@ constraint. + This way, the third clause will still be marked as inaccessible RHS instead + of redundant. This is ensured by calling 'lookupVarInfoNT'. +3. Immediately reject when we find @x /~ T2 at . +Handling of Newtypes is also described in the Appendix of the Lower Your Guards paper, +where you can find the solution in a perhaps more digestible format. -} -lookupRefuts :: Uniquable k => Delta -> k -> [PmAltCon] +lookupRefuts :: Uniquable k => Nabla -> k -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. -lookupRefuts MkDelta{ delta_tm_st = ts@(TmSt (SDIE env) _) } k = +lookupRefuts MkNabla{ nabla_tm_st = ts@(TmSt (SDIE env) _) } k = case lookupUDFM_Directly env (getUnique k) of Nothing -> [] Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y)) @@ -772,10 +779,10 @@ isDataConSolution :: (PmAltCon, [TyVar], [Id]) -> Bool isDataConSolution (PmAltConLike (RealDataCon _), _, _) = True isDataConSolution _ = False --- @lookupSolution delta x@ picks a single solution ('vi_pos') of @x@ from +-- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. -lookupSolution :: Delta -> Id -> Maybe (PmAltCon, [TyVar], [Id]) -lookupSolution delta x = case vi_pos (lookupVarInfo (delta_tm_st delta) x) of +lookupSolution :: Nabla -> Id -> Maybe (PmAltCon, [TyVar], [Id]) +lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of [] -> Nothing pos | Just sol <- find isDataConSolution pos -> Just sol @@ -842,13 +849,13 @@ instance Outputable PmCt where ppr (PmTyCt pred_ty) = ppr pred_ty ppr (PmTmCt tm_ct) = ppr tm_ct --- | Adds new constraints to 'Delta' and returns 'Nothing' if that leads to a +-- | Adds new constraints to 'Nabla' and returns 'Nothing' if that leads to a -- contradiction. -addPmCts :: Delta -> PmCts -> DsM (Maybe Delta) +addPmCts :: Nabla -> PmCts -> DsM (Maybe Nabla) -- See Note [TmState invariants]. -addPmCts delta cts = do +addPmCts nabla cts = do let (ty_cts, tm_cts) = partitionTyTmCts cts - runSatisfiabilityCheck delta $ mconcat + runSatisfiabilityCheck nabla $ mconcat [ tyIsSatisfiable True (listToBag ty_cts) , tmIsSatisfiable (listToBag tm_cts) ] @@ -861,44 +868,40 @@ partitionTyTmCts = partitionEithers . map to_either . toList -- | Adds a single term constraint by dispatching to the various term oracle -- functions. -addTmCt :: Delta -> TmCt -> MaybeT DsM Delta -addTmCt delta (TmVarCt x y) = addVarCt delta x y -addTmCt delta (TmCoreCt x e) = addCoreCt delta x e -addTmCt delta (TmConCt x con tvs args) = addConCt delta x con tvs args -addTmCt delta (TmNotConCt x con) = addNotConCt delta x con -addTmCt delta (TmBotCt x) = addBotCt delta x -addTmCt delta (TmNotBotCt x) = addNotBotCt delta x +addTmCt :: Nabla -> TmCt -> MaybeT DsM Nabla +addTmCt nabla (TmVarCt x y) = addVarCt nabla x y +addTmCt nabla (TmCoreCt x e) = addCoreCt nabla x e +addTmCt nabla (TmConCt x con tvs args) = addConCt nabla x con tvs args +addTmCt nabla (TmNotConCt x con) = addNotConCt nabla x con +addTmCt nabla (TmBotCt x) = addBotCt nabla x +addTmCt nabla (TmNotBotCt x) = addNotBotCt nabla x -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ --- surely diverges. --- --- Only that's a lie, because we don't currently preserve the fact in 'Delta' --- after we checked compatibility. See Note [Preserving TmBotCt] -addBotCt :: Delta -> Id -> MaybeT DsM Delta -addBotCt delta x - | canDiverge delta x = pure delta - | otherwise = mzero - -{- Note [Preserving TmBotCt] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Whenever we add a new constraint to 'Delta' via 'addTmCt', we want to check it -for compatibility with existing constraints in the modeled indert set and then -add it the constraint itself to the inert set. -For a 'TmBotCt' @x ~ ⊥@ we don't actually add it to the inert set after checking -it for compatibility with 'Delta'. -And that is fine in the context of the patter-match checking algorithm! -Whenever we add a 'TmBotCt' (we only do so for checking divergence of bang -patterns and strict constructor matches), we don't add any more constraints to -the inert set afterwards, so we don't need to preserve it. --} +-- surely diverges. Quite similar to 'addConCt', only that it only cares about +-- ⊥. +addBotCt :: Nabla -> Id -> MaybeT DsM Nabla +addBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do + let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + case bot of + IsNotBot -> mzero -- There was x /~ ⊥. Contradiction! + IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do + MaybeBot -> do -- We add x ~ ⊥ + let vi' = vi{ vi_bot = IsBot } + pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env y vi') reps} -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't --- take the shape of a 'PmAltCon' @K@ in the 'Delta' and return @Nothing@ if +-- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if -- that leads to a contradiction. -- See Note [TmState invariants]. -addNotConCt :: Delta -> Id -> PmAltCon -> MaybeT DsM Delta -addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do - vi@(VI _ pos neg pm) <- lift (initLookupVarInfo delta x) +addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla +addNotConCt _ _ (PmAltConLike (RealDataCon dc)) + | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] +addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do + -- For good performance, it's important to initPossibleMatches here. + -- Otherwise we can't mark nalt as matched later on, incurring unnecessary + -- inhabitation tests for nalt. + vi@(VI _ pos neg _ pm) <- lift $ initPossibleMatches (nabla_ty_st nabla) + (lookupVarInfo ts x) -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt (cl, _tvs, _args) = eqPmAltCon cl nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -910,13 +913,14 @@ addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do -- See Note [Completeness checking with required Thetas] | hasRequiredTheta nalt = neg | otherwise = extendPmAltConSet neg nalt - let vi_ext = vi{ vi_neg = neg' } + MASSERT( isPmAltConMatchStrict nalt ) + let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor - vi' <- case nalt of + vi2 <- case nalt of PmAltConLike cl - -> MaybeT (ensureInhabited delta vi_ext{ vi_cache = markMatched cl pm }) - _ -> pure vi_ext - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x vi') reps } + -> ensureInhabited nabla vi1{ vi_cache = markMatched cl pm } + _ -> pure vi1 + pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -979,100 +983,104 @@ guessConLikeUnivTyArgsFromResTy _ res_ty (PatSynCon ps) = do subst <- tcMatchTy con_res_ty res_ty traverse (lookupTyVar subst) univ_tvs --- | Adds the constraint @x ~/ ⊥@ to 'Delta'. +-- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', +-- but only cares for the ⊥ "constructor". +addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla +addNotBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do + let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + case bot of + IsBot -> mzero -- There was x ~ ⊥. Contradiction! + IsNotBot -> pure nabla -- There already is x /~ ⊥. Nothing left to do + MaybeBot -> do -- We add x /~ ⊥ and test if x is still inhabited + vi <- ensureInhabited nabla vi{ vi_bot = IsNotBot } + pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env y vi) reps} + +-- | Returns (Just vi) if at least one member of each ConLike in the COMPLETE +-- set satisfies the oracle -- --- But doesn't really commit to upholding that constraint in the future. This --- will be rectified in a follow-up patch. The status quo should work good --- enough for now. -addNotBotCt :: Delta -> Id -> MaybeT DsM Delta -addNotBotCt delta at MkDelta{ delta_tm_st = TmSt env reps } x = do - vi <- lift $ initLookupVarInfo delta x - vi' <- MaybeT $ ensureInhabited delta vi - -- vi' has probably constructed and then thinned out some PossibleMatches. - -- We want to cache that work - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x vi') reps} - -ensureInhabited :: Delta -> VarInfo -> DsM (Maybe VarInfo) - -- Returns (Just vi) if at least one member of each ConLike in the COMPLETE - -- set satisfies the oracle - -- - -- Internally uses and updates the ConLikeSets in vi_cache. - -- - -- NB: Does /not/ filter each ConLikeSet with the oracle; members may - -- remain that do not statisfy it. This lazy approach just - -- avoids doing unnecessary work. -ensureInhabited delta vi = fmap (set_cache vi) <$> test (vi_cache vi) -- This would be much less tedious with lenses +-- Internally uses and updates the ConLikeSets in vi_cache. +-- +-- NB: Does /not/ filter each ConLikeSet with the oracle; members may +-- remain that do not statisfy it. This lazy approach just +-- avoids doing unnecessary work. +ensureInhabited :: Nabla -> VarInfo -> MaybeT DsM VarInfo +ensureInhabited nabla vi = case vi_bot vi of + MaybeBot -> pure vi -- The |-Bot rule from the paper + IsBot -> pure vi + IsNotBot -> lift (initPossibleMatches (nabla_ty_st nabla) vi) >>= inst_complete_sets where - set_cache vi cache = vi { vi_cache = cache } - - test NoPM = pure (Just NoPM) - test (PM ms) = runMaybeT (PM <$> traverse one_set ms) - - one_set cs = find_one_inh cs (uniqDSetToList cs) - - find_one_inh :: ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet - -- (find_one_inh cs cls) iterates over cls, deleting from cs + -- | This is the |-Inst rule from the paper (section 4.5). Tries to + -- find an inhabitant in every complete set by instantiating with one their + -- constructors. If there is any complete set where we can't find an + -- inhabitant, the whole thing is uninhabited. + inst_complete_sets :: VarInfo -> MaybeT DsM VarInfo + inst_complete_sets vi at VI{ vi_cache = NoPM } = pure vi + inst_complete_sets vi at VI{ vi_cache = PM ms } = do + ms <- traverse (\cs -> inst_complete_set vi cs (uniqDSetToList cs)) ms + pure vi{ vi_cache = PM ms } + + inst_complete_set :: VarInfo -> ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet + -- (inst_complete_set cs cls) iterates over cls, deleting from cs -- any uninhabited elements of cls. Stop (returning Just cs) -- when you see an inhabited element; return Nothing if all -- are uninhabited - find_one_inh _ [] = mzero - find_one_inh cs (con:cons) = lift (inh_test con) >>= \case + inst_complete_set _ _ [] = mzero + inst_complete_set vi cs (con:cons) = lift (inst_and_test vi con) >>= \case True -> pure cs - False -> find_one_inh (delOneFromUniqDSet cs con) cons + False -> inst_complete_set vi (delOneFromUniqDSet cs con) cons - inh_test :: ConLike -> DsM Bool - -- @inh_test K@ Returns False if a non-bottom value @v::ty@ cannot possibly + inst_and_test :: VarInfo -> ConLike -> DsM Bool + -- @inst_and_test K@ Returns False if a non-bottom value @v::ty@ cannot possibly -- be of form @K _ _ _ at . Returning True is always sound. -- -- It's like 'DataCon.dataConCannotMatch', but more clever because it takes - -- the facts in Delta into account. - inh_test con = do + -- the facts in Nabla into account. + inst_and_test vi con = do env <- dsGetFamInstEnvs case guessConLikeUnivTyArgsFromResTy env (vi_ty vi) con of Nothing -> pure True -- be conservative about this Just arg_tys -> do (_tvs, _vars, ty_cs, strict_arg_tys) <- mkOneConFull arg_tys con - tracePm "inh_test" (ppr con $$ ppr ty_cs) + tracePm "inst_and_test" (ppr con $$ ppr ty_cs) -- No need to run the term oracle compared to pmIsSatisfiable - fmap isJust <$> runSatisfiabilityCheck delta $ mconcat + fmap isJust <$> runSatisfiabilityCheck nabla $ mconcat -- Important to pass False to tyIsSatisfiable here, so that we won't - -- recursively call ensureAllPossibleMatchesInhabited, leading to an + -- recursively call ensureAllInhabited, leading to an -- endless recursion. [ tyIsSatisfiable False ty_cs , tysAreNonVoid initRecTc strict_arg_tys ] -- | Checks if every 'VarInfo' in the term oracle has still an inhabited --- 'vi_cache', considering the current type information in 'Delta'. +-- 'vi_cache', considering the current type information in 'Nabla'. -- This check is necessary after having matched on a GADT con to weed out -- impossible matches. -ensureAllPossibleMatchesInhabited :: Delta -> DsM (Maybe Delta) -ensureAllPossibleMatchesInhabited delta at MkDelta{ delta_tm_st = TmSt env reps } - = runMaybeT (set_tm_cs_env delta <$> traverseSDIE go env) +ensureAllInhabited :: Nabla -> DsM (Maybe Nabla) +ensureAllInhabited nabla at MkNabla{ nabla_tm_st = TmSt env reps } + = runMaybeT (set_tm_cs_env nabla <$> traverseSDIE go env) where - set_tm_cs_env delta env = delta{ delta_tm_st = TmSt env reps } - go vi = MaybeT $ - initPossibleMatches (delta_ty_st delta) vi >>= ensureInhabited delta + set_tm_cs_env nabla env = nabla{ nabla_tm_st = TmSt env reps } + go vi = ensureInhabited nabla vi -------------------------------------- -- * Term oracle unification procedure -- | Adds a @x ~ y@ constraint by trying to unify two 'Id's and record the --- gained knowledge in 'Delta'. +-- gained knowledge in 'Nabla'. -- --- Returns @Nothing@ when there's a contradiction. Returns @Just delta@ --- when the constraint was compatible with prior facts, in which case @delta@ +-- Returns @Nothing@ when there's a contradiction. Returns @Just nabla@ +-- when the constraint was compatible with prior facts, in which case @nabla@ -- has integrated the knowledge from the equality constraint. -- -- See Note [TmState invariants]. -addVarCt :: Delta -> Id -> Id -> MaybeT DsM Delta -addVarCt delta at MkDelta{ delta_tm_st = TmSt env _ } x y +addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +addVarCt nabla at MkNabla{ nabla_tm_st = TmSt env _ } x y -- It's important that we never @equate@ two variables of the same equivalence -- class, otherwise we might get cyclic substitutions. -- Cf. 'extendSubstAndSolve' and -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . - | sameRepresentativeSDIE env x y = pure delta - | otherwise = equate delta x y + | sameRepresentativeSDIE env x y = pure nabla + | otherwise = equate nabla x y -- | @equate ts@(TmSt env) x y@ merges the equivalence classes of @x@ and @y@ by -- adding an indirection to the environment. @@ -1081,12 +1089,12 @@ addVarCt delta at MkDelta{ delta_tm_st = TmSt env _ } x y -- Preconditions: @not (sameRepresentativeSDIE env x y)@ -- -- See Note [TmState invariants]. -equate :: Delta -> Id -> Id -> MaybeT DsM Delta -equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y +equate :: Nabla -> Id -> Id -> MaybeT DsM Nabla +equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y = ASSERT( not (sameRepresentativeSDIE env x y) ) case (lookupSDIE env x, lookupSDIE env y) of - (Nothing, _) -> pure (delta{ delta_tm_st = TmSt (setIndirectSDIE env x y) reps }) - (_, Nothing) -> pure (delta{ delta_tm_st = TmSt (setIndirectSDIE env y x) reps }) + (Nothing, _) -> pure (nabla{ nabla_tm_st = TmSt (setIndirectSDIE env x y) reps }) + (_, Nothing) -> pure (nabla{ nabla_tm_st = TmSt (setIndirectSDIE env y x) reps }) -- Merge the info we have for x into the info for y (Just vi_x, Just vi_y) -> do -- This assert will probably trigger at some point... @@ -1096,16 +1104,16 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y let env_ind = setIndirectSDIE env x y -- Then sum up the refinement counters let env_refs = setEntrySDIE env_ind y vi_y - let delta_refs = delta{ delta_tm_st = TmSt env_refs reps } + let nabla_refs = nabla{ nabla_tm_st = TmSt env_refs reps } -- and then gradually merge every positive fact we have on x into y - let add_fact delta (cl, tvs, args) = addConCt delta y cl tvs args - delta_pos <- foldlM add_fact delta_refs (vi_pos vi_x) + let add_fact nabla (cl, tvs, args) = addConCt nabla y cl tvs args + nabla_pos <- foldlM add_fact nabla_refs (vi_pos vi_x) -- Do the same for negative info - let add_refut delta nalt = addNotConCt delta y nalt - delta_neg <- foldlM add_refut delta_pos (pmAltConSetElems (vi_neg vi_x)) + let add_refut nabla nalt = addNotConCt nabla y nalt + nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) -- vi_cache will be updated in addNotConCt, so we are good to -- go! - pure delta_neg + pure nabla_neg -- | Add a @x ~ K tvs args ts@ constraint. -- @addConCt x K tvs args ts@ extends the substitution with a solution @@ -1113,9 +1121,9 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y -- have on @x@, reject (@Nothing@) otherwise. -- -- See Note [TmState invariants]. -addConCt :: Delta -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Delta -addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do - VI ty pos neg cache <- lift (initLookupVarInfo delta x) +addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla +addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do + let VI ty pos neg bot cache = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -1131,10 +1139,19 @@ addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do when (length args /= length other_args) $ lift $ tracePm "error" (ppr x <+> ppr alt <+> ppr args <+> ppr other_args) let tm_cts = zipWithEqual "addConCt" PmVarCt args other_args - MaybeT $ addPmCts delta (listToBag ty_cts `unionBags` listToBag tm_cts) + MaybeT $ addPmCts nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = (alt, tvs, args):pos - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg cache)) reps} + let nabla_with bot = nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot cache)) reps} + -- Do (2) in Note [Coverage checking Newtype matches] + case (alt, args) of + (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> + case bot of + MaybeBot -> pure (nabla_with MaybeBot) + IsBot -> addBotCt (nabla_with MaybeBot) y + IsNotBot -> addNotBotCt (nabla_with MaybeBot) y + _ -> ASSERT( isPmAltConMatchStrict alt ) + pure (nabla_with IsNotBot) -- strict match ==> not ⊥ equateTys :: [Type] -> [Type] -> [PmCt] equateTys ts us = @@ -1183,9 +1200,9 @@ mkInhabitationCandidate x dc = do -- if it can. In this case, the candidates are the signature of the tycon, each -- one accompanied by the term- and type- constraints it gives rise to. -- See also Note [Checking EmptyCase Expressions] -inhabitationCandidates :: Delta -> Type +inhabitationCandidates :: Nabla -> Type -> DsM (Either Type (TyCon, Id, [InhabitationCandidate])) -inhabitationCandidates MkDelta{ delta_ty_st = ty_st } ty = do +inhabitationCandidates MkNabla{ nabla_ty_st = ty_st } ty = do pmTopNormaliseType ty_st ty >>= \case NoChange _ -> alts_to_check ty ty [] NormalisedByConstraints ty' -> alts_to_check ty' ty' [] @@ -1281,20 +1298,20 @@ we do the following: -- | A 'SatisfiabilityCheck' based on "NonVoid ty" constraints, e.g. Will -- check if the @strict_arg_tys@ are actually all inhabited. --- Returns the old 'Delta' if all the types are non-void according to 'Delta'. +-- Returns the old 'Nabla' if all the types are non-void according to 'Nabla'. tysAreNonVoid :: RecTcChecker -> [Type] -> SatisfiabilityCheck -tysAreNonVoid rec_env strict_arg_tys = SC $ \delta -> do - all_non_void <- checkAllNonVoid rec_env delta strict_arg_tys +tysAreNonVoid rec_env strict_arg_tys = SC $ \nabla -> do + all_non_void <- checkAllNonVoid rec_env nabla strict_arg_tys -- Check if each strict argument type is inhabitable pure $ if all_non_void - then Just delta + then Just nabla else Nothing -- | Implements two performance optimizations, as described in -- @Note [Strict argument type constraints]@. -checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> DsM Bool +checkAllNonVoid :: RecTcChecker -> Nabla -> [Type] -> DsM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - let definitely_inhabited = definitelyInhabitedType (delta_ty_st amb_cs) + let definitely_inhabited = definitelyInhabitedType (nabla_ty_st amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys -- See Note [Fuel for the inhabitation test] let rec_max_bound | tys_to_check `lengthExceeds` 1 @@ -1309,7 +1326,7 @@ checkAllNonVoid rec_ts amb_cs strict_arg_tys = do -- See @Note [Strict argument type constraints]@. nonVoid :: RecTcChecker -- ^ The per-'TyCon' recursion depth limit. - -> Delta -- ^ The ambient term/type constraints (known to be + -> Nabla -- ^ The ambient term/type constraints (known to be -- satisfiable). -> Type -- ^ The strict argument type. -> DsM Bool -- ^ 'True' if the strict argument type might be inhabited by @@ -1337,7 +1354,7 @@ nonVoid rec_ts amb_cs strict_arg_ty = do -- check if recursion is detected). -- -- See Note [Strict argument type constraints] - cand_is_inhabitable :: RecTcChecker -> Delta + cand_is_inhabitable :: RecTcChecker -> Nabla -> InhabitationCandidate -> DsM Bool cand_is_inhabitable rec_ts amb_cs (InhabitationCandidate{ ic_cs = new_cs @@ -1516,21 +1533,21 @@ on a list of strict argument types, we filter out all of the DI ones. -} -------------------------------------------- --- * Providing positive evidence for a Delta +-- * Providing positive evidence for a Nabla --- | @provideEvidence vs n delta@ returns a list of --- at most @n@ (but perhaps empty) refinements of @delta@ that instantiate +-- | @provideEvidence vs n nabla@ returns a list of +-- at most @n@ (but perhaps empty) refinements of @nabla@ that instantiate -- @vs@ to compatible constructor applications or wildcards. -- Negative information is only retained if literals are involved or when -- for recursive GADTs. -provideEvidence :: [Id] -> Int -> Delta -> DsM [Delta] +provideEvidence :: [Id] -> Int -> Nabla -> DsM [Nabla] provideEvidence = go where go _ 0 _ = pure [] - go [] _ delta = pure [delta] - go (x:xs) n delta = do - tracePm "provideEvidence" (ppr x $$ ppr xs $$ ppr delta $$ ppr n) - VI _ pos neg _ <- initLookupVarInfo delta x + go [] _ nabla = pure [nabla] + go (x:xs) n nabla = do + tracePm "provideEvidence" (ppr x $$ ppr xs $$ ppr nabla $$ ppr n) + let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x case pos of _:_ -> do -- All solutions must be valid at once. Try to find candidates for their @@ -1543,56 +1560,58 @@ provideEvidence = go -- some @y@ and @SomePatSyn z@ for some @z at . We must find evidence for @y@ -- and @z@ that is valid at the same time. These constitute arg_vas below. let arg_vas = concatMap (\(_cl, _tvs, args) -> args) pos - go (arg_vas ++ xs) n delta + go (arg_vas ++ xs) n nabla [] -- When there are literals involved, just print negative info -- instead of listing missed constructors | notNull [ l | PmAltLit l <- pmAltConSetElems neg ] - -> go xs n delta - [] -> try_instantiate x xs n delta + -> go xs n nabla + [] -> try_instantiate x xs n nabla -- | Tries to instantiate a variable by possibly following the chain of -- newtypes and then instantiating to all ConLikes of the wrapped type's -- minimal residual COMPLETE set. - try_instantiate :: Id -> [Id] -> Int -> Delta -> DsM [Delta] + try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. - try_instantiate x xs n delta = do - (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (delta_ty_st delta) (idType x) - let build_newtype (x, delta) (_ty, dc, arg_ty) = do + try_instantiate x xs n nabla = do + (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + let build_newtype (x, nabla) (_ty, dc, arg_ty) = do y <- lift $ mkPmId arg_ty -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - delta' <- addConCt delta x (PmAltConLike (RealDataCon dc)) [] [y] - pure (y, delta') - runMaybeT (foldlM build_newtype (x, delta) dcs) >>= \case + nabla' <- addConCt nabla x (PmAltConLike (RealDataCon dc)) [] [y] + pure (y, nabla') + runMaybeT (foldlM build_newtype (x, nabla) dcs) >>= \case Nothing -> pure [] - Just (y, newty_delta) -> do + Just (y, newty_nabla) -> do -- Pick a COMPLETE set and instantiate it (n at max). Take care of ⊥. - pm <- vi_cache <$> initLookupVarInfo newty_delta y - mb_cls <- pickMinimalCompleteSet newty_delta pm + let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + vi <- initPossibleMatches (nabla_ty_st newty_nabla) vi + mb_cls <- pickMinimalCompleteSet newty_nabla (vi_cache vi) case uniqDSetToList <$> mb_cls of - Just cls@(_:_) -> instantiate_cons y core_ty xs n newty_delta cls - Just [] | not (canDiverge newty_delta y) -> pure [] - -- Either ⊥ is still possible (think Void) or there are no COMPLETE - -- sets available, so we can assume it's inhabited - _ -> go xs n newty_delta - - instantiate_cons :: Id -> Type -> [Id] -> Int -> Delta -> [ConLike] -> DsM [Delta] + Just cls -> do + nablas <- instantiate_cons y core_ty xs n newty_nabla cls + if null nablas && vi_bot vi /= IsNotBot + then go xs n newty_nabla -- bot is still possible. Display a wildcard! + else pure nablas + Nothing -> go xs n newty_nabla -- no COMPLETE sets ==> inhabited + + instantiate_cons :: Id -> Type -> [Id] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] instantiate_cons _ _ _ 0 _ _ = pure [] - instantiate_cons _ ty xs n delta _ + instantiate_cons _ ty xs n nabla _ -- We don't want to expose users to GHC-specific constructors for Int etc. | fmap (isTyConTriviallyInhabited . fst) (splitTyConApp_maybe ty) == Just True - = go xs n delta - instantiate_cons x ty xs n delta (cl:cls) = do + = go xs n nabla + instantiate_cons x ty xs n nabla (cl:cls) = do env <- dsGetFamInstEnvs case guessConLikeUnivTyArgsFromResTy env ty cl of - Nothing -> pure [delta] -- No idea how to refine this one, so just finish off with a wildcard + Nothing -> pure [nabla] -- No idea how to refine this one, so just finish off with a wildcard Just arg_tys -> do (tvs, arg_vars, new_ty_cs, strict_arg_tys) <- mkOneConFull arg_tys cl let new_tm_cs = unitBag (TmConCt x (PmAltConLike cl) tvs arg_vars) -- Now check satifiability - mb_delta <- pmIsSatisfiable delta new_ty_cs new_tm_cs strict_arg_tys + mb_nabla <- pmIsSatisfiable nabla new_ty_cs new_tm_cs strict_arg_tys tracePm "instantiate_cons" (vcat [ ppr x , ppr (idType x) , ppr ty @@ -1601,21 +1620,21 @@ provideEvidence = go , ppr new_tm_cs , ppr new_ty_cs , ppr strict_arg_tys - , ppr delta - , ppr mb_delta + , ppr nabla + , ppr mb_nabla , ppr n ]) - con_deltas <- case mb_delta of + con_nablas <- case mb_nabla of Nothing -> pure [] -- NB: We don't prepend arg_vars as we don't have any evidence on -- them and we only want to split once on a data type. They are -- inhabited, otherwise pmIsSatisfiable would have refuted. - Just delta' -> go xs n delta' - other_cons_deltas <- instantiate_cons x ty xs (n - length con_deltas) delta cls - pure (con_deltas ++ other_cons_deltas) + Just nabla' -> go xs n nabla' + other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls + pure (con_nablas ++ other_cons_nablas) -pickMinimalCompleteSet :: Delta -> PossibleMatches -> DsM (Maybe ConLikeSet) +pickMinimalCompleteSet :: Nabla -> PossibleMatches -> DsM (Maybe ConLikeSet) pickMinimalCompleteSet _ NoPM = pure Nothing --- TODO: First prune sets with type info in delta. But this is good enough for +-- TODO: First prune sets with type info in nabla. But this is good enough for -- now and less costly. See #17386. pickMinimalCompleteSet _ (PM clss) = do tracePm "pickMinimalCompleteSet" (ppr $ NonEmpty.toList clss) @@ -1625,14 +1644,14 @@ pickMinimalCompleteSet _ (PM clss) = do -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically -- equivalent to @e'@) we encountered earlier, or a fresh identifier if -- there weren't any such constraints. -representCoreExpr :: Delta -> CoreExpr -> DsM (Delta, Id) -representCoreExpr delta at MkDelta{ delta_tm_st = ts at TmSt{ ts_reps = reps } } e - | Just rep <- lookupCoreMap reps e = pure (delta, rep) +representCoreExpr :: Nabla -> CoreExpr -> DsM (Nabla, Id) +representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e + | Just rep <- lookupCoreMap reps e = pure (nabla, rep) | otherwise = do rep <- mkPmId (exprType e) let reps' = extendCoreMap reps e rep - let delta' = delta{ delta_tm_st = ts{ ts_reps = reps' } } - pure (delta', rep) + let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } + pure (nabla', rep) -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -1646,16 +1665,16 @@ representCoreExpr delta at MkDelta{ delta_tm_st = ts at TmSt{ ts_reps = reps } } e -- for other literals. See 'coreExprAsPmLit'. -- * Finally, if we have @let x = e@ and we already have seen @let y = e@, we -- want to record @x ~ y at . -addCoreCt :: Delta -> Id -> CoreExpr -> MaybeT DsM Delta -addCoreCt delta x e = do +addCoreCt :: Nabla -> Id -> CoreExpr -> MaybeT DsM Nabla +addCoreCt nabla x e = do dflags <- getDynFlags let e' = simpleOptExpr dflags e - lift $ tracePm "addCoreCt" (ppr x <+> dcolon <+> ppr (idType x) $$ ppr e $$ ppr e') - execStateT (core_expr x e') delta + -- lift $ tracePm "addCoreCt" (ppr x <+> dcolon <+> ppr (idType x) $$ ppr e $$ ppr e') + execStateT (core_expr x e') nabla where -- | Takes apart a 'CoreExpr' and tries to extract as much information about -- literals and constructor applications as possible. - core_expr :: Id -> CoreExpr -> StateT Delta (MaybeT DsM) () + core_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () -- TODO: Handle newtypes properly, by wrapping the expression in a DataCon -- This is the right thing for casts involving data family instances and -- their representation TyCon, though (which are not visible in source @@ -1680,7 +1699,7 @@ addCoreCt delta x e = do -- See Note [Detecting pattern synonym applications in expressions] | Var y <- e, Nothing <- isDataConId_maybe x -- We don't consider DataCons flexible variables - = modifyT (\delta -> addVarCt delta x y) + = modifyT (\nabla -> addVarCt nabla x y) | otherwise -- Any other expression. Try to find other uses of a semantically -- equivalent expression and represent them by the same variable! @@ -1698,13 +1717,13 @@ addCoreCt delta x e = do -- see if we already encountered a constraint @let y = e'@ with @e'@ -- semantically equivalent to @e@, in which case we may add the constraint -- @x ~ y at . - equate_with_similar_expr :: Id -> CoreExpr -> StateT Delta (MaybeT DsM) () + equate_with_similar_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () equate_with_similar_expr x e = do - rep <- StateT $ \delta -> swap <$> lift (representCoreExpr delta e) + rep <- StateT $ \nabla -> swap <$> lift (representCoreExpr nabla e) -- Note that @rep == x@ if we encountered @e@ for the first time. - modifyT (\delta -> addVarCt delta x rep) + modifyT (\nabla -> addVarCt nabla x rep) - bind_expr :: CoreExpr -> StateT Delta (MaybeT DsM) Id + bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id bind_expr e = do x <- lift (lift (mkPmId (exprType e))) core_expr x e @@ -1712,10 +1731,12 @@ addCoreCt delta x e = do -- | Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): - -- 1. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i@ - -- 2. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ - -- 3. @x ~ K as ys@ - data_con_app :: Id -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Delta (MaybeT DsM) () + -- 1. @x /~ ⊥@ if 'K' is not a Newtype constructor. + -- 2. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i@ + -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ + -- 4. @x ~ K as ys@ + -- This is quite similar to PmCheck.pmConCts. + data_con_app :: Id -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Nabla (MaybeT DsM) () data_con_app x in_scope dc args = do let dc_ex_tvs = dataConExTyCoVars dc arty = dataConSourceArity dc @@ -1725,20 +1746,27 @@ addCoreCt delta x e = do uniq_supply <- lift $ lift $ getUniqueSupplyM let (_, ex_tvs) = cloneTyVarBndrs (mkEmptyTCvSubst in_scope) dc_ex_tvs uniq_supply ty_cts = equateTys (map mkTyVarTy ex_tvs) ex_tys - -- 1. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i at . See also #17703 - modifyT $ \delta -> MaybeT $ addPmCts delta (listToBag ty_cts) - -- 2. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ + -- 1. @x /~ ⊥@ if 'K' is not a Newtype constructor (#18341) + when (not (isNewDataCon dc)) $ + modifyT $ \nabla -> addNotBotCt nabla x + -- 2. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i at . See also #17703 + modifyT $ \nabla -> MaybeT $ addPmCts nabla (listToBag ty_cts) + -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ arg_ids <- traverse bind_expr vis_args - -- 3. @x ~ K as ys@ + -- 4. @x ~ K as ys@ pm_alt_con_app x (PmAltConLike (RealDataCon dc)) ex_tvs arg_ids -- | Adds a literal constraint, i.e. @x ~ 42 at . - pm_lit :: Id -> PmLit -> StateT Delta (MaybeT DsM) () - pm_lit x lit = pm_alt_con_app x (PmAltLit lit) [] [] + -- Also we assume that literal expressions won't diverge, so this + -- will add a @x ~/ ⊥@ constraint. + pm_lit :: Id -> PmLit -> StateT Nabla (MaybeT DsM) () + pm_lit x lit = do + modifyT $ \nabla -> addNotBotCt nabla x + pm_alt_con_app x (PmAltLit lit) [] [] -- | Adds the given constructor application as a solution for @x at . - pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Delta (MaybeT DsM) () - pm_alt_con_app x con tvs args = modifyT $ \delta -> addConCt delta x con tvs args + pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Nabla (MaybeT DsM) () + pm_alt_con_app x con tvs args = modifyT $ \nabla -> addConCt nabla x con tvs args -- | Like 'modify', but with an effectful modifier action modifyT :: Monad m => (s -> m s) -> StateT s m () ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} --- | Provides factilities for pretty-printing 'Delta's in a way appropriate for +-- | Provides factilities for pretty-printing 'Nabla's in a way appropriate for -- user facing pattern match warnings. module GHC.HsToCore.PmCheck.Ppr ( pprUncovered @@ -42,8 +42,8 @@ import GHC.HsToCore.PmCheck.Oracle -- -- When the set of refutable shapes contains more than 3 elements, the -- additional elements are indicated by "...". -pprUncovered :: Delta -> [Id] -> SDoc -pprUncovered delta vas +pprUncovered :: Nabla -> [Id] -> SDoc +pprUncovered nabla vas | isNullUDFM refuts = fsep vec -- there are no refutations | otherwise = hang (fsep vec) 4 $ text "where" <+> vcat (map (pprRefutableShapes . snd) (udfmToList refuts)) @@ -54,8 +54,8 @@ pprUncovered delta vas | [_] <- vas = topPrec | otherwise = appPrec ppr_action = mapM (pprPmVar init_prec) vas - (vec, renamings) = runPmPpr delta ppr_action - refuts = prettifyRefuts delta renamings + (vec, renamings) = runPmPpr nabla ppr_action + refuts = prettifyRefuts nabla renamings -- | Output refutable shapes of a variable in the form of @var is not one of {2, -- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is @@ -98,21 +98,21 @@ substitution to the vectors before printing them out (see function `pprOne' in -- | Extract and assigns pretty names to constraint variables with refutable -- shapes. -prettifyRefuts :: Delta -> DIdEnv SDoc -> DIdEnv (SDoc, [PmAltCon]) -prettifyRefuts delta = listToUDFM_Directly . map attach_refuts . udfmToList +prettifyRefuts :: Nabla -> DIdEnv SDoc -> DIdEnv (SDoc, [PmAltCon]) +prettifyRefuts nabla = listToUDFM_Directly . map attach_refuts . udfmToList where - attach_refuts (u, sdoc) = (u, (sdoc, lookupRefuts delta u)) + attach_refuts (u, sdoc) = (u, (sdoc, lookupRefuts nabla u)) -type PmPprM a = RWS Delta () (DIdEnv SDoc, [SDoc]) a +type PmPprM a = RWS Nabla () (DIdEnv SDoc, [SDoc]) a -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ [ text ('t':show u) | u <- [(0 :: Int)..] ] -runPmPpr :: Delta -> PmPprM a -> (a, DIdEnv SDoc) -runPmPpr delta m = case runRWS m delta (emptyDVarEnv, nameList) of +runPmPpr :: Nabla -> PmPprM a -> (a, DIdEnv SDoc) +runPmPpr nabla m = case runRWS m nabla (emptyDVarEnv, nameList) of (a, (renamings, _), _) -> (a, renamings) -- | Allocates a new, clean name for the given 'Id' if it doesn't already have @@ -129,8 +129,8 @@ getCleanName x = do checkRefuts :: Id -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached checkRefuts x = do - delta <- ask - case lookupRefuts delta x of + nabla <- ask + case lookupRefuts nabla x of [] -> pure Nothing -- Will just be a wildcard later on _ -> Just <$> getCleanName x @@ -144,8 +144,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc -- The useful information in the latter case is the constructor that we missed, -- not the types of the wildcards in the places that aren't matched as a result. pprPmVar prec x = do - delta <- ask - case lookupSolution delta x of + nabla <- ask + case lookupSolution nabla x of Just (alt, _tvs, args) -> pprPmAltCon prec alt args Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where @@ -160,24 +160,24 @@ pprPmVar prec x = do pprPmAltCon :: PprPrec -> PmAltCon -> [Id] -> PmPprM SDoc pprPmAltCon _prec (PmAltLit l) _ = pure (ppr l) pprPmAltCon prec (PmAltConLike cl) args = do - delta <- ask - pprConLike delta prec cl args + nabla <- ask + pprConLike nabla prec cl args -pprConLike :: Delta -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc -pprConLike delta _prec cl args - | Just pm_expr_list <- pmExprAsList delta (PmAltConLike cl) args +pprConLike :: Nabla -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc +pprConLike nabla _prec cl args + | Just pm_expr_list <- pmExprAsList nabla (PmAltConLike cl) args = case pm_expr_list of NilTerminated list -> brackets . fsep . punctuate comma <$> mapM (pprPmVar appPrec) list WcVarTerminated pref x -> parens . fcat . punctuate colon <$> mapM (pprPmVar appPrec) (toList pref ++ [x]) -pprConLike _delta _prec (RealDataCon con) args +pprConLike _nabla _prec (RealDataCon con) args | isUnboxedTupleCon con , let hash_parens doc = text "(#" <+> doc <+> text "#)" = hash_parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args | isTupleDataCon con = parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args -pprConLike _delta prec cl args +pprConLike _nabla prec cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmVar funPrec x y' <- pprPmVar funPrec y @@ -202,11 +202,11 @@ data PmExprList -- ending in a wildcard variable x (of list type). Should be pretty-printed as -- (1:2:_). -- * @pmExprAsList [] == Just ('NilTerminated' [])@ -pmExprAsList :: Delta -> PmAltCon -> [Id] -> Maybe PmExprList -pmExprAsList delta = go_con [] +pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList +pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution delta x + | Just (alt, _tvs, args) <- lookupSolution nabla x = go_con rev_pref alt args go_var rev_pref x | Just pref <- nonEmpty (reverse rev_pref) ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -15,6 +15,7 @@ Author: George Karachalias module GHC.HsToCore.PmCheck.Types ( -- * Representations for Literals and AltCons PmLit(..), PmLitValue(..), PmAltCon(..), pmLitType, pmAltConType, + isPmAltConMatchStrict, pmAltConImplBangs, -- ** Equality on 'PmAltCon's PmEquality(..), eqPmAltCon, @@ -35,8 +36,8 @@ module GHC.HsToCore.PmCheck.Types ( setIndirectSDIE, setEntrySDIE, traverseSDIE, -- * The pattern match oracle - VarInfo(..), TmState(..), TyState(..), Delta(..), - Deltas(..), initDeltas, liftDeltasM + BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), + Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -226,6 +227,19 @@ pmAltConType :: PmAltCon -> [Type] -> Type pmAltConType (PmAltLit lit) _arg_tys = ASSERT( null _arg_tys ) pmLitType lit pmAltConType (PmAltConLike con) arg_tys = conLikeResTy con arg_tys +-- | Is a match on this constructor forcing the match variable? +-- True of data constructors, literals and pattern synonyms (#17357), but not of +-- newtypes. +-- See Note [Coverage checking Newtype matches] in "GHC.HsToCore.PmCheck.Oracle". +isPmAltConMatchStrict :: PmAltCon -> Bool +isPmAltConMatchStrict PmAltLit{} = True +isPmAltConMatchStrict (PmAltConLike PatSynCon{}) = True -- #17357 +isPmAltConMatchStrict (PmAltConLike (RealDataCon dc)) = not (isNewDataCon dc) + +pmAltConImplBangs :: PmAltCon -> [HsImplBang] +pmAltConImplBangs PmAltLit{} = [] +pmAltConImplBangs (PmAltConLike con) = conLikeImplBangs con + {- Note [Undecidable Equality for PmAltCons] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -477,6 +491,13 @@ instance Outputable a => Outputable (Shared a) where instance Outputable a => Outputable (SharedDIdEnv a) where ppr (SDIE env) = ppr env +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + -- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These -- entries are possibly shared when we figure out that two variables must be -- equal, thus represent the same set of values. @@ -531,6 +552,13 @@ data VarInfo -- because files like Cabal's `LicenseId` define relatively huge enums -- that lead to quadratic or worse behavior. + , vi_bot :: BotInfo + -- ^ Can this variable be ⊥? Models (mutually contradicting) @x ~ ⊥@ and + -- @x ≁ ⊥@ constraints. E.g. + -- * 'MaybeBot': Don't know; Neither @x ~ ⊥@ nor @x ≁ ⊥@. + -- * 'IsBot': @x ~ ⊥@ + -- * 'IsNotBot': @x ≁ ⊥@ + , vi_cache :: !PossibleMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of -- possible constructors of each COMPLETE set. So, if it's not in here, we @@ -538,14 +566,19 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +instance Outputable BotInfo where + ppr MaybeBot = empty + ppr IsBot = text "~⊥" + ppr IsNotBot = text "≁⊥" + -- | Not user-facing. instance Outputable TmState where ppr (TmSt state reps) = ppr state $$ ppr reps -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr cache])) + ppr (VI ty pos neg bot cache) + = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) -- | Initial state of the term oracle. initTmState :: TmState @@ -563,37 +596,38 @@ instance Outputable TyState where initTyState :: TyState initTyState = TySt emptyBag --- | An inert set of canonical (i.e. mutually compatible) term and type --- constraints. -data Delta = MkDelta { delta_ty_st :: TyState -- Type oracle; things like a~Int - , delta_tm_st :: TmState } -- Term oracle; things like x~Nothing +-- | A normalised refinement type ∇ (\"nabla\"), comprised of an inert set of +-- canonical (i.e. mutually compatible) term and type constraints that form the +-- refinement type's predicate. +data Nabla = MkNabla { nabla_ty_st :: TyState -- Type oracle; things like a~Int + , nabla_tm_st :: TmState } -- Term oracle; things like x~Nothing --- | An initial delta that is always satisfiable -initDelta :: Delta -initDelta = MkDelta initTyState initTmState +-- | An initial nabla that is always satisfiable +initNabla :: Nabla +initNabla = MkNabla initTyState initTmState -instance Outputable Delta where - ppr delta = hang (text "Delta") 2 $ vcat [ +instance Outputable Nabla where + ppr nabla = hang (text "Nabla") 2 $ vcat [ -- intentionally formatted this way enable the dev to comment in only -- the info she needs - ppr (delta_tm_st delta), - ppr (delta_ty_st delta) + ppr (nabla_tm_st nabla), + ppr (nabla_ty_st nabla) ] --- | A disjunctive bag of 'Delta's, representing a refinement type. -newtype Deltas = MkDeltas (Bag Delta) +-- | A disjunctive bag of 'Nabla's, representing a refinement type. +newtype Nablas = MkNablas (Bag Nabla) -initDeltas :: Deltas -initDeltas = MkDeltas (unitBag initDelta) +initNablas :: Nablas +initNablas = MkNablas (unitBag initNabla) -instance Outputable Deltas where - ppr (MkDeltas deltas) = ppr deltas +instance Outputable Nablas where + ppr (MkNablas nablas) = ppr nablas -instance Semigroup Deltas where - MkDeltas l <> MkDeltas r = MkDeltas (l `unionBags` r) +instance Semigroup Nablas where + MkNablas l <> MkNablas r = MkNablas (l `unionBags` r) -instance Monoid Deltas where - mempty = MkDeltas emptyBag +instance Monoid Nablas where + mempty = MkNablas emptyBag -liftDeltasM :: Monad m => (Delta -> m (Maybe Delta)) -> Deltas -> m Deltas -liftDeltasM f (MkDeltas ds) = MkDeltas . catBagMaybes <$> (traverse f ds) +liftNablasM :: Monad m => (Nabla -> m (Maybe Nabla)) -> Nablas -> m Nablas +liftNablasM f (MkNablas ds) = MkNablas . catBagMaybes <$> (traverse f ds) ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot ===================================== @@ -2,8 +2,8 @@ module GHC.HsToCore.PmCheck.Types where import GHC.Data.Bag -data Delta +data Nabla -newtype Deltas = MkDeltas (Bag Delta) +newtype Nablas = MkNablas (Bag Nabla) -initDeltas :: Deltas +initNablas :: Nablas ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -106,7 +106,7 @@ import GHC.Tc.Types.Origin import GHC.Types.Annotations import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Deltas) +import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Data.IOEnv import GHC.Types.Name.Reader import GHC.Types.Name @@ -324,9 +324,9 @@ data DsLclEnv = DsLclEnv { dsl_loc :: RealSrcSpan, -- To put in pattern-matching error msgs -- See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck" - -- The set of reaching values Deltas is augmented as we walk inwards, + -- The set of reaching values Nablas is augmented as we walk inwards, -- refined through each pattern match in turn - dsl_deltas :: Deltas + dsl_nablas :: Nablas } -- Inside [| |] brackets, the desugarer looks ===================================== testsuite/tests/pmcheck/should_compile/T10183.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE GADTs, DataKinds, TypeOperators, UnicodeSyntax #-} + +module Foo where + +import GHC.TypeLits + +data List l t where + Nil ∷ List 0 t + (:-) ∷ t → List l t → List (l+1) t + +head' ∷ (1<=l) ⇒ List l t → t +head' (x :- _) = x + +data T a where + TT :: T Bool + TF :: T Int + +f :: T Bool -> Bool +f TT = True + +g :: (a ~ Bool) => T a -> Bool +g TT = True ===================================== testsuite/tests/pmcheck/should_compile/T17340.stderr ===================================== @@ -7,6 +7,10 @@ T17340.hs:19:4: warning: [-Wredundant-bang-patterns] Pattern match has redundant bang In an equation for ‘g’: g x = ... +T17340.hs:23:9: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘h’: h x = ... + T17340.hs:27:4: warning: [-Wredundant-bang-patterns] Pattern match has redundant bang In an equation for ‘k’: k _ = ... ===================================== testsuite/tests/pmcheck/should_compile/T17378.hs ===================================== @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE EmptyCase #-} +module Lib where + +import Data.Type.Equality +import Data.Functor.Identity +import Data.Void + +f :: a :~: Int -> a :~: Bool -> () +f !_ x = case x of {} + +g :: Identity (a :~: Int) -> a :~: Bool -> () +g (Identity _) Refl = () + +data SMaybe a = SNothing + | SJust !a + +-- | Exhaustive. Note how in addition to @{(a,b) | b /~ True}@, the value set +-- @{(a,b) | y /~ SNothing, b ~ True}@ flows into the next equation, but @y@ is +-- no longer in scope. Normally, we have no way of matching on that without a +-- wildcard match, but in this case we refute @y ~ SJust z@ by unleashing type +-- evidence saying that @z@ must be 'Void' by matching on 'Refl'. +h :: forall a. a :~: Void -> Bool -> () +h _ True | let y = undefined :: SMaybe a, SNothing <- y = () +h Refl False = () ===================================== testsuite/tests/pmcheck/should_compile/T17725.hs ===================================== @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +module Lib where + +newtype IInt = IInt Int + +f :: IInt -> Bool -> () +f !(IInt _) True = () +f (IInt 42) True = () +f _ _ = () ===================================== testsuite/tests/pmcheck/should_compile/T17725.stderr ===================================== @@ -0,0 +1,4 @@ + +T17725.hs:9:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f (IInt 42) True = ... ===================================== testsuite/tests/pmcheck/should_compile/T17729.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -fforce-recomp -Wincomplete-patterns #-} + +incomplete :: Maybe a -> Bool +incomplete ma = case (ma, ()) of + (Nothing, _) -> False + +{-# COMPLETE Pat #-} +pattern Pat :: a -> b -> (a, b) +pattern Pat a b = (a, b) + +main :: IO () +main = print $ incomplete (Just ()) ===================================== testsuite/tests/pmcheck/should_compile/T17729.stderr ===================================== @@ -0,0 +1,4 @@ + +T17729.hs:5:17: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: Patterns not matched: ((Just _), ()) ===================================== testsuite/tests/pmcheck/should_compile/T17977.stderr ===================================== @@ -0,0 +1,10 @@ + +T17977.hs:31:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: + Patterns not matched: + SZ SZ SZ _ + SZ SZ (SS _) _ + SZ (SS _) SZ _ + SZ (SS _) (SS _) _ + ... ===================================== testsuite/tests/pmcheck/should_compile/T18273.hs ===================================== @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -fforce-recomp -Wincomplete-patterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} + +module Bug where + +import Data.Kind +import Data.Void + +type SFalse = SBool 'False +type STrue = SBool 'True + +data SBool :: Bool -> Type where + SFalse :: SFalse + STrue :: STrue + +type family F (b :: Bool) :: Type where + F 'False = Void + F 'True = () + +data T (b :: Bool) + = MkT1 + | MkT2 !(F b) + +ex :: SBool b -> T b -> () +ex sb t = + case t of + MkT1 -> () + MkT2 f -> + case sb of + STrue -> f + +ex2 :: SBool b -> T b -> () +ex2 sb t = + case t of + MkT2 f -> + case sb of + STrue -> f + MkT1 -> () ===================================== testsuite/tests/pmcheck/should_compile/T18341.hs ===================================== @@ -0,0 +1,24 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} + +module Lib where + +import GHC.Exts + +data T = MkT !Int {-# UNPACK #-} !Int Int# + +f :: T -> () +f (MkT _ _ _) | False = () -- inaccessible +f (MkT !_ _ _) | False = () -- redundant, not only inaccessible! +f _ = () + +g :: T -> () +g (MkT _ _ _) | False = () -- inaccessible +g (MkT _ !_ _) | False = () -- redundant, not only inaccessible! +g _ = () + +h :: T -> () +h (MkT _ _ _) | False = () -- inaccessible +h (MkT _ _ !_) | False = () -- redundant, not only inaccessible! +h _ = () ===================================== testsuite/tests/pmcheck/should_compile/T18341.stderr ===================================== @@ -0,0 +1,24 @@ + +T18341.hs:12:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f (MkT _ _ _) | False = ... + +T18341.hs:13:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f (MkT !_ _ _) | False = ... + +T18341.hs:17:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘g’: g (MkT _ _ _) | False = ... + +T18341.hs:18:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘g’: g (MkT _ !_ _) | False = ... + +T18341.hs:22:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘h’: h (MkT _ _ _) | False = ... + +T18341.hs:23:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (MkT _ _ !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/T18670.hs ===================================== @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeOperators #-} + +module Lib where + +import Data.Type.Equality + +data T a where + TInt :: T Int + TBool :: T Bool + +f :: T a -> a :~: Int -> () +f TInt Refl = () ===================================== testsuite/tests/pmcheck/should_compile/T18670.stderr ===================================== @@ -0,0 +1,4 @@ + +T18670.hs:16:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: Patterns not matched: TBool _ ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -36,6 +36,8 @@ test('T9951b', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T9951', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T10183', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11303', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) test('T11276', collect_compiler_stats('bytes allocated',10), compile, @@ -108,12 +110,18 @@ test('T17357', expect_broken(17357), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17376', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17378', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17465', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17646', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17703', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17725', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17729', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17783', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17977', collect_compiler_stats('bytes allocated',10), compile, @@ -122,12 +130,18 @@ test('T17977b', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18049', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18273', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18341', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18478', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18533', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) +test('T18670', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/065216d42291477b3368ba0ec98077cbae7e4cce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/065216d42291477b3368ba0ec98077cbae7e4cce You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 14:31:24 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Wed, 09 Sep 2020 10:31:24 -0400 Subject: [Git][ghc/ghc][wip/T18599] Some reformatting and tests Message-ID: <5f58e73c1f936_80b3f84864770a811217670@gitlab.haskell.org.mail> Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: 42011e7d by Shayne Fletcher at 2020-09-09T10:30:53-04:00 Some reformatting and tests - - - - - 4 changed files: - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - + record-dot-syntax-tests/Construction.hs - + record-dot-syntax-tests/Pattern.hs Changes: ===================================== compiler/GHC/Parser.y ===================================== @@ -3239,7 +3239,7 @@ fbinds1 :: { forall b. DisambECP b => PV ([AddAnn],([Fbind b], Maybe SrcSpan)) } fbind :: { forall b. DisambECP b => PV (Fbind b) } : qvar '=' texp { unECP $3 >>= \ $3 -> - return $ Fbind (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False) + fmap Fbind $ return (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False) -- ams (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False) [mj AnnEqual $2] } -- RHS is a 'texp', allowing view patterns (#6038) @@ -3247,32 +3247,32 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } -- f (R { x = show -> s }) = ... | qvar { placeHolderPunRhs >>= \rhs -> - return $ Fbind (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) rhs True) + fmap Fbind $ return (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) rhs True) } -- In the punning case, use a place-holder -- The renamer fills in the final value -- See Note [Whitespace-sensitive operator parsing] in Lexer.x | field TIGHT_INFIX_PROJ fieldToUpdate '=' texp - {do - $5 <- unECP $5 - fmap Pbind $ mkHsFieldUpdaterPV (comb2 $1 $5) ($1 : reverse $3) $5 - } + { do + $5 <- unECP $5 + fmap Pbind $ mkHsFieldUpdaterPV (comb2 $1 $5) ($1 : reverse $3) $5 + } -- See Note [Whitespace-sensitive operator parsing] in Lexer.x | field TIGHT_INFIX_PROJ fieldToUpdate - {do - let top = $1 - fields = top : reverse $3 - final = last fields - l = comb2 top final - puns <- getBit RecordPunsBit - when (not puns) $ - addError l $ - text "For this to work, enable NamedFieldPuns." - var <- mkHsVarPV (noLoc (mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final)) - fmap Pbind $ mkHsFieldUpdaterPV l fields var - } + { do + let top = $1 + fields = top : reverse $3 + final = last fields + l = comb2 top final + puns <- getBit RecordPunsBit + when (not puns) $ + addError l $ + text "For this to work, enable NamedFieldPuns." + var <- mkHsVarPV (noLoc (mkRdrUnqual . mkVarOcc . unpackFS . unLoc $ final)) + fmap Pbind $ mkHsFieldUpdaterPV l fields var + } fieldToUpdate :: { [Located FastString] } fieldToUpdate ===================================== compiler/GHC/Parser/PostProcess.hs ===================================== @@ -1523,7 +1523,7 @@ instance DisambECP (HsCmd GhcPs) where ecpFromExp' (L l e) = cmdFail l (ppr e) mkHsFieldUpdaterPV l _ _ = cmdFail l $ - text "Field update syntax is not supported in commands." + text "Field selector syntax is not supported in commands." mkHsLamPV l mg = return $ L l (HsCmdLam noExtField mg) mkHsLetPV l bs e = return $ L l (HsCmdLet noExtField bs e) type InfixOp (HsCmd GhcPs) = HsExpr GhcPs @@ -1677,7 +1677,7 @@ instance DisambECP (PatBuilder GhcPs) where text "Expression syntax in pattern:" <+> ppr e mkHsFieldUpdaterPV l _ _ = addFatalError l $ - text "Field update syntax is not supported in patterns." + text "Field selector syntax is not supported in patterns." mkHsLamPV l _ = addFatalError l $ text "Lambda-syntax in pattern." $$ text "Pattern matching on functions is not possible." ===================================== record-dot-syntax-tests/Construction.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE RecordDotSyntax #-} + +no = Foo { bar.baz = 1 } + -- Syntax error: Can't use '.' in construction. ===================================== record-dot-syntax-tests/Pattern.hs ===================================== @@ -0,0 +1,5 @@ +{-# LANGUAGE RecordDotSyntax #-} + +no Foo{bar.baz = x} = undefined + -- Syntax error: "Field selector syntax is not supported in + -- patterns." View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42011e7dac076856d9caf925358d7ab387104de5 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/42011e7dac076856d9caf925358d7ab387104de5 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 15:19:30 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 09 Sep 2020 11:19:30 -0400 Subject: [Git][ghc/ghc][master] 4 commits: DynFlags: add OptCoercionOpts Message-ID: <5f58f28235f22_80ba949e181122258f@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 30 changed files: - compiler/GHC.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/SimpleOpt.hs - + compiler/GHC/Core/SimpleOpt.hs-boot - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold.hs-boot - + compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - + compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Foreign/Decl.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/822f10575d207a2a47b21ac853dcf28c655041c4...ffae57921168365272bf7ce8aaa645917bfdf218 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/822f10575d207a2a47b21ac853dcf28c655041c4...ffae57921168365272bf7ce8aaa645917bfdf218 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 15:20:13 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 09 Sep 2020 11:20:13 -0400 Subject: [Git][ghc/ghc][master] Remove GENERATED pragma, as it is not being used Message-ID: <5f58f2adc32cd_80b3f849633e99c11229122@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 18 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/Lexer.x - compiler/GHC/Rename/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs - testsuite/tests/ghc-api/annotations/T10313.stdout - testsuite/tests/ghc-api/annotations/T11430.stdout - testsuite/tests/ghc-api/annotations/Test10313.hs - testsuite/tests/ghc-api/annotations/Test11430.hs - testsuite/tests/ghc-api/annotations/stringSource.hs - testsuite/tests/ghc-api/annotations/t11430.hs - testsuite/tests/printer/Makefile - − testsuite/tests/printer/Ppr047.hs - testsuite/tests/printer/all.T - utils/haddock Changes: ===================================== compiler/GHC/Hs/Expr.hs ===================================== @@ -838,21 +838,10 @@ data HsPragE p -- 'GHC.Parser.Annotation.AnnVal', -- 'GHC.Parser.Annotation.AnnClose' @'\#-}'@ - -- For details on above see note [Api annotations] in GHC.Parser.Annotation - | HsPragTick -- A pragma introduced tick - (XTickPragma p) - SourceText -- Note [Pragma source text] in GHC.Types.Basic - (StringLiteral,(Int,Int),(Int,Int)) - -- external span for this tick - ((SourceText,SourceText),(SourceText,SourceText)) - -- Source text for the four integers used in the span. - -- See note [Pragma source text] in GHC.Types.Basic - | XHsPragE !(XXPragE p) type instance XSCC (GhcPass _) = NoExtField type instance XCoreAnn (GhcPass _) = NoExtField -type instance XTickPragma (GhcPass _) = NoExtField type instance XXPragE (GhcPass _) = NoExtCon -- | Located Haskell Tuple Argument @@ -1402,13 +1391,6 @@ instance Outputable (HsPragE (GhcPass p)) where -- no doublequotes if stl empty, for the case where the SCC was written -- without quotes. <+> pprWithSourceText stl (ftext lbl) <+> text "#-}" - ppr (HsPragTick _ st (StringLiteral sta s, (v1,v2), (v3,v4)) ((s1,s2),(s3,s4))) = - pprWithSourceText st (text "{-# GENERATED") - <+> pprWithSourceText sta (doubleQuotes $ ftext s) - <+> pprWithSourceText s1 (ppr v1) <+> char ':' <+> pprWithSourceText s2 (ppr v2) - <+> char '-' - <+> pprWithSourceText s3 (ppr v3) <+> char ':' <+> pprWithSourceText s4 (ppr v4) - <+> text "#-}" {- ************************************************************************ ===================================== compiler/GHC/HsToCore/Coverage.hs ===================================== @@ -618,10 +618,6 @@ addTickHsExpr (HsTick x t e) = addTickHsExpr (HsBinTick x t0 t1 e) = liftM (HsBinTick x t0 t1) (addTickLHsExprNever e) -addTickHsExpr (HsPragE _ HsPragTick{} (L pos e0)) = do - e2 <- allocTickBox (ExpBox False) False False pos $ - addTickHsExpr e0 - return $ unLoc e2 addTickHsExpr (HsPragE x p e) = liftM (HsPragE x p) (addTickLHsExpr e) addTickHsExpr e@(HsBracket {}) = return e ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -820,11 +820,6 @@ ds_prag_expr (HsPragSCC _ _ cc) expr = do Tick (ProfNote (mkUserCC nm mod_name (getLoc expr) flavour) count True) <$> dsLExpr expr else dsLExpr expr -ds_prag_expr (HsPragTick _ _ _ _) expr = do - dflags <- getDynFlags - if gopt Opt_Hpc dflags - then panic "dsExpr:HsPragTick" - else dsLExpr expr ------------------------------ dsSyntaxExpr :: SyntaxExpr GhcTc -> [CoreExpr] -> DsM CoreExpr ===================================== compiler/GHC/HsToCore/Quote.hs ===================================== @@ -1572,7 +1572,6 @@ repE (HsUnboundVar _ uv) = do repUnboundVar sname repE (XExpr (HsExpanded _ b)) = repE b repE e@(HsPragE _ HsPragSCC {} _) = notHandled "Cost centres" (ppr e) -repE e@(HsPragE _ HsPragTick {} _) = notHandled "Tick Pragma" (ppr e) repE e = notHandled "Expression form" (ppr e) ----------------------------------------------------------------------------- ===================================== compiler/GHC/Parser.y ===================================== @@ -514,7 +514,6 @@ are the most common patterns, rewritten as regular expressions for clarity: '{-# SOURCE' { L _ (ITsource_prag _) } '{-# RULES' { L _ (ITrules_prag _) } '{-# SCC' { L _ (ITscc_prag _)} - '{-# GENERATED' { L _ (ITgenerated_prag _) } '{-# DEPRECATED' { L _ (ITdeprecated_prag _) } '{-# WARNING' { L _ (ITwarning_prag _) } '{-# UNPACK' { L _ (ITunpack_prag _) } @@ -2525,8 +2524,7 @@ optSemi :: { ([Located Token],Bool) } {- Note [Pragmas and operator fixity] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -'prag_e' is an expression pragma, such as {-# SCC ... #-} or -{-# GENERATED ... #-}. +'prag_e' is an expression pragma, such as {-# SCC ... #-}. It must be used with care, or else #15730 happens. Consider this infix expression: @@ -2580,20 +2578,6 @@ prag_e :: { Located ([AddAnn], HsPragE GhcPs) } HsPragSCC noExtField (getSCC_PRAGs $1) (StringLiteral NoSourceText (getVARID $2))) } - | '{-# GENERATED' STRING INTEGER ':' INTEGER HYPHEN INTEGER ':' INTEGER '#-}' - { let getINT = fromInteger . il_value . getINTEGER in - sLL $1 $> $ ([mo $1,mj AnnVal $2 - ,mj AnnVal $3,mj AnnColon $4 - ,mj AnnVal $5] ++ $6 ++ - [mj AnnVal $7,mj AnnColon $8 - ,mj AnnVal $9,mc $10], - HsPragTick noExtField - (getGENERATED_PRAGs $1) - (getStringLiteral $2, - (getINT $3, getINT $5), - (getINT $7, getINT $9)) - ((getINTEGERs $3, getINTEGERs $5), - (getINTEGERs $7, getINTEGERs $9) )) } fexp :: { ECP } : fexp aexp { ECP $ superFunArg $ @@ -3700,7 +3684,6 @@ getRULES_PRAGs (L _ (ITrules_prag src)) = src getWARNING_PRAGs (L _ (ITwarning_prag src)) = src getDEPRECATED_PRAGs (L _ (ITdeprecated_prag src)) = src getSCC_PRAGs (L _ (ITscc_prag src)) = src -getGENERATED_PRAGs (L _ (ITgenerated_prag src)) = src getUNPACK_PRAGs (L _ (ITunpack_prag src)) = src getNOUNPACK_PRAGs (L _ (ITnounpack_prag src)) = src getANN_PRAGs (L _ (ITann_prag src)) = src ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -743,7 +743,6 @@ data Token | ITline_prag SourceText -- not usually produced, see 'UsePosPragsBit' | ITcolumn_prag SourceText -- not usually produced, see 'UsePosPragsBit' | ITscc_prag SourceText - | ITgenerated_prag SourceText | ITunpack_prag SourceText | ITnounpack_prag SourceText | ITann_prag SourceText @@ -3289,7 +3288,6 @@ oneWordPrags = Map.fromList [ ("warning", strtoken (\s -> ITwarning_prag (SourceText s))), ("deprecated", strtoken (\s -> ITdeprecated_prag (SourceText s))), ("scc", strtoken (\s -> ITscc_prag (SourceText s))), - ("generated", strtoken (\s -> ITgenerated_prag (SourceText s))), ("unpack", strtoken (\s -> ITunpack_prag (SourceText s))), ("nounpack", strtoken (\s -> ITnounpack_prag (SourceText s))), ("ann", strtoken (\s -> ITann_prag (SourceText s))), ===================================== compiler/GHC/Rename/Expr.hs ===================================== @@ -243,7 +243,6 @@ rnExpr (HsPragE x prag expr) where rn_prag :: HsPragE GhcPs -> HsPragE GhcRn rn_prag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann - rn_prag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo rnExpr (HsLam x matches) = do { (matches', fvMatch) <- rnMatchGroup LambdaExpr rnLExpr matches ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1082,7 +1082,6 @@ tcExpr other _ = pprPanic "tcLExpr" (ppr other) tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc tcExprPrag (HsPragSCC x1 src ann) = HsPragSCC x1 src ann -tcExprPrag (HsPragTick x1 src info srcInfo) = HsPragTick x1 src info srcInfo {- ********************************************************************* ===================================== testsuite/tests/ghc-api/annotations/T10313.stdout ===================================== @@ -10,5 +10,4 @@ ([c], [(SourceText "foo\x63", fooc), (SourceText "b\x61r", bar)]), ([r], [(SourceText "foo1\x67", foo1g)]), ([s, t], [(SourceText "a\x62", ab)]), - ([s, c], [(SourceText "foo\x64", food)]), - ([t, p], [(SourceText "foob\x61r", foobar)])] + ([s, c], [(SourceText "foo\x64", food)])] ===================================== testsuite/tests/ghc-api/annotations/T11430.stdout ===================================== @@ -3,4 +3,3 @@ ("ia",["1"]) ("ia",["0x999"]) ("ia",["1"]) -("tp",["((SourceText \"0x1\",SourceText \"0x2\"),(SourceText \"0x3\",SourceText \"0x4\"))"]) ===================================== testsuite/tests/ghc-api/annotations/Test10313.hs ===================================== @@ -33,5 +33,3 @@ strictStream (Bitstream l v) Exact l b = {-# SCC "foo\x64" #-} 006 - -c = {-# GENERATED "foob\x61r" 1 : 2 - 3 : 4 #-} 0.00 ===================================== testsuite/tests/ghc-api/annotations/Test11430.hs ===================================== @@ -21,5 +21,3 @@ x = undefined {-# INLINABLE [1] y #-} y :: (Num a, Integral b) => a -> b -> a y = undefined - -c = {-# GENERATED "foob\x61r" 0x1 : 0x2 - 0x3 : 0x4 #-} 0.00 ===================================== testsuite/tests/ghc-api/annotations/stringSource.hs ===================================== @@ -86,7 +86,6 @@ testOneFile libdir fileName = do doPragE :: HsPragE GhcPs -> [(String,[Located (SourceText,FastString)])] doPragE (HsPragSCC _ src ss) = [("sc",[conv (noLoc ss)])] - doPragE (HsPragTick _ src (ss,_,_) _ss2) = [("tp",[conv (noLoc ss)])] conv (GHC.L l (StringLiteral st fs)) = GHC.L l (st,fs) ===================================== testsuite/tests/ghc-api/annotations/t11430.hs ===================================== @@ -68,7 +68,6 @@ testOneFile libdir fileName = do doRuleDecl (HsRule _ _ _ _ _ _ _) = [] doHsExpr :: HsExpr GhcPs -> [(String,[String])] - doHsExpr (HsPragE _ (HsPragTick _ src (_,_,_) ss) _) = [("tp",[show ss])] doHsExpr _ = [] doInline (InlinePragma _ _ _ (ActiveBefore (SourceText ss) _) _) ===================================== testsuite/tests/printer/Makefile ===================================== @@ -190,10 +190,6 @@ ppr045: ppr046: $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr046.hs -.PHONY: ppr047 -ppr047: - $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr047.hs - .PHONY: ppr048 ppr048: $(CHECK_PPR) "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" Ppr048.hs ===================================== testsuite/tests/printer/Ppr047.hs deleted ===================================== @@ -1,3 +0,0 @@ -module ExprPragmas where - -c = {-# GENERATED "foobar" 1 : 2 - 3 : 4 #-} 0.00 ===================================== testsuite/tests/printer/all.T ===================================== @@ -44,7 +44,6 @@ test('Ppr043', [ignore_stderr, req_interp], makefile_test, ['ppr043']) test('Ppr044', ignore_stderr, makefile_test, ['ppr044']) test('Ppr045', ignore_stderr, makefile_test, ['ppr045']) test('Ppr046', ignore_stderr, makefile_test, ['ppr046']) -test('Ppr047', ignore_stderr, makefile_test, ['ppr047']) test('Ppr048', ignore_stderr, makefile_test, ['ppr048']) test('T13199', [ignore_stderr, req_interp], makefile_test, ['T13199']) test('T13050p', ignore_stderr, makefile_test, ['T13050p']) ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit 54468d1e60cb10093120137766cfc9dd91671c98 +Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7911d0d983a68eb0d54d7c1ba51326d6be737aae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7911d0d983a68eb0d54d7c1ba51326d6be737aae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 15:28:01 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 09 Sep 2020 11:28:01 -0400 Subject: [Git][ghc/ghc][wip/T18603] 53 commits: base: Better error message on invalid getSystemTimerManager call Message-ID: <5f58f4814d338_80b89edd8011230775@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18603 at Glasgow Haskell Compiler / GHC Commits: 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 7df4c69a by Simon Peyton Jones at 2020-09-09T16:26:34+01:00 Fix the occurrence analyser Ticket #18603 demonstrated that the occurrence analyser's handling of local RULES for imported Ids (which I now call IMP-RULES) was inadequate. It led the simplifier into an infnite loop by failing to label a binder as a loop breaker. The main change in this commit is to treat IMP-RULES in a simple and uniform way: as extra rules for the local binder. See Note [IMP-RULES: local rules for imported functions] This led to quite a bit of refactoring. The result is still tricky, but it's much better than before, and better documented I think. Oh, and it fixes the bug. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Monad.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca76dac5b0162c7a7388dd8f9a9ca4c070df4666...7df4c69a690a1d2ec93790fc0a925e73faa525a3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ca76dac5b0162c7a7388dd8f9a9ca4c070df4666...7df4c69a690a1d2ec93790fc0a925e73faa525a3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 15:44:07 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 09 Sep 2020 11:44:07 -0400 Subject: [Git][ghc/ghc][wip/T18603] Fix the occurrence analyser Message-ID: <5f58f8478c9d1_80b89edd8011235137@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18603 at Glasgow Haskell Compiler / GHC Commits: 3b2531f6 by Simon Peyton Jones at 2020-09-09T16:43:31+01:00 Fix the occurrence analyser Ticket #18603 demonstrated that the occurrence analyser's handling of local RULES for imported Ids (which I now call IMP-RULES) was inadequate. It led the simplifier into an infnite loop by failing to label a binder as a loop breaker. The main change in this commit is to treat IMP-RULES in a simple and uniform way: as extra rules for the local binder. See Note [IMP-RULES: local rules for imported functions] This led to quite a bit of refactoring. The result is still tricky, but it's much better than before, and better documented I think. Oh, and it fixes the bug. - - - - - 4 changed files: - compiler/GHC/Core/FVs.hs - compiler/GHC/Core/Opt/OccurAnal.hs - + testsuite/tests/simplCore/should_compile/T18603.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/FVs.hs ===================================== @@ -10,16 +10,12 @@ Taken quite directly from the Peyton Jones/Lester paper. -- | A module concerned with finding the free variables of an expression. module GHC.Core.FVs ( -- * Free variables of expressions and binding groups - exprFreeVars, + exprFreeVars, exprsFreeVars, exprFreeVarsDSet, - exprFreeVarsList, - exprFreeIds, - exprFreeIdsDSet, - exprFreeIdsList, - exprsFreeIdsDSet, - exprsFreeIdsList, - exprsFreeVars, - exprsFreeVarsList, + exprFreeVarsList, exprsFreeVarsList, + exprFreeIds, exprsFreeIds, + exprFreeIdsDSet, exprsFreeIdsDSet, + exprFreeIdsList, exprsFreeIdsList, bindFreeVars, -- * Selective free variables of expressions @@ -126,6 +122,9 @@ exprFreeVarsList = fvVarList . exprFVs exprFreeIds :: CoreExpr -> IdSet -- Find all locally-defined free Ids exprFreeIds = exprSomeFreeVars isLocalId +exprsFreeIds :: [CoreExpr] -> IdSet -- Find all locally-defined free Ids +exprsFreeIds = exprsSomeFreeVars isLocalId + -- | Find all locally-defined free Ids in an expression -- returning a deterministic set. exprFreeIdsDSet :: CoreExpr -> DIdSet -- Find all locally-defined free Ids ===================================== compiler/GHC/Core/Opt/OccurAnal.hs ===================================== @@ -61,10 +61,15 @@ import Data.List Here's the externally-callable interface: -} +occurAnalyseExpr :: CoreExpr -> CoreExpr +-- Do occurrence analysis, and discard occurrence info returned +occurAnalyseExpr expr + = snd (occAnal initOccEnv expr) + occurAnalysePgm :: Module -- Used only in debug output -> (Id -> Bool) -- Active unfoldings -> (Activation -> Bool) -- Active rules - -> [CoreRule] + -> [CoreRule] -- Local rules for imported Ids -> CoreProgram -> CoreProgram occurAnalysePgm this_mod active_unf active_rule imp_rules binds | isEmptyDetails final_usage @@ -95,15 +100,21 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds initial_uds = addManyOccs emptyDetails (rulesFreeVars imp_rules) -- The RULES declarations keep things alive! - -- Note [Preventing loops due to imported functions rules] - imp_rule_edges = foldr (plusVarEnv_C unionVarSet) emptyVarEnv - [ mapVarEnv (const maps_to) $ - getUniqSet (exprFreeIds arg `delVarSetList` ru_bndrs imp_rule) - | imp_rule <- imp_rules - , not (isBuiltinRule imp_rule) -- See Note [Plugin rules] - , let maps_to = exprFreeIds (ru_rhs imp_rule) - `delVarSetList` ru_bndrs imp_rule - , arg <- ru_args imp_rule ] + -- imp_rule_edges maps a top-level local binder 'f' to the + -- RHS free vars of any IMP-RULE, a local RULE for an imported function, + -- where 'f' appears on the LHS + -- e.g. RULE foldr f = blah + -- imp_rule_edges contains f :-> fvs(blah) + -- We treat such RULES as extra rules for 'f' + -- See Note [Preventing loops due to imported functions rules] + imp_rule_edges :: ImpRuleEdges + imp_rule_edges = foldr (plusVarEnv_C (++)) emptyVarEnv + [ mapVarEnv (const [(act,rhs_fvs)]) $ getUniqSet $ + exprsFreeIds args `delVarSetList` bndrs + | Rule { ru_act = act, ru_bndrs = bndrs + , ru_args = args, ru_rhs = rhs } <- imp_rules + -- Not BuiltinRules; see Note [Plugin rules] + , let rhs_fvs = exprFreeIds rhs `delVarSetList` bndrs ] go :: OccEnv -> [CoreBind] -> (UsageDetails, [CoreBind]) go _ [] @@ -115,297 +126,64 @@ occurAnalysePgm this_mod active_unf active_rule imp_rules binds (final_usage, bind') = occAnalBind env TopLevel imp_rule_edges bind bs_usage -occurAnalyseExpr :: CoreExpr -> CoreExpr --- Do occurrence analysis, and discard occurrence info returned -occurAnalyseExpr expr - = snd (occAnal initOccEnv expr) - -{- Note [Plugin rules] -~~~~~~~~~~~~~~~~~~~~~~ -Conal Elliott (#11651) built a GHC plugin that added some -BuiltinRules (for imported Ids) to the mg_rules field of ModGuts, to -do some domain-specific transformations that could not be expressed -with an ordinary pattern-matching CoreRule. But then we can't extract -the dependencies (in imp_rule_edges) from ru_rhs etc, because a -BuiltinRule doesn't have any of that stuff. - -So we simply assume that BuiltinRules have no dependencies, and filter -them out from the imp_rule_edges comprehension. --} - -{- -************************************************************************ +{- ********************************************************************* * * - Bindings + IMP-RULES + Local rules for imported functions * * -************************************************************************ - -Note [Recursive bindings: the grand plan] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When we come across a binding group - Rec { x1 = r1; ...; xn = rn } -we treat it like this (occAnalRecBind): - -1. Occurrence-analyse each right hand side, and build a - "Details" for each binding to capture the results. - - Wrap the details in a Node (details, node-id, dep-node-ids), - where node-id is just the unique of the binder, and - dep-node-ids lists all binders on which this binding depends. - We'll call these the "scope edges". - See Note [Forming the Rec groups]. - - All this is done by makeNode. - -2. Do SCC-analysis on these Nodes. Each SCC will become a new Rec or - NonRec. The key property is that every free variable of a binding - is accounted for by the scope edges, so that when we are done - everything is still in scope. - -3. For each Cyclic SCC of the scope-edge SCC-analysis in (2), we - identify suitable loop-breakers to ensure that inlining terminates. - This is done by occAnalRec. - -4. To do so we form a new set of Nodes, with the same details, but - different edges, the "loop-breaker nodes". The loop-breaker nodes - have both more and fewer dependencies than the scope edges - (see Note [Choosing loop breakers]) - - More edges: if f calls g, and g has an active rule that mentions h - then we add an edge from f -> h - - Fewer edges: we only include dependencies on active rules, on rule - RHSs (not LHSs) and if there is an INLINE pragma only - on the stable unfolding (and vice versa). The scope - edges must be much more inclusive. - -5. The "weak fvs" of a node are, by definition: - the scope fvs - the loop-breaker fvs - See Note [Weak loop breakers], and the nd_weak field of Details - -6. Having formed the loop-breaker nodes - -Note [Dead code] -~~~~~~~~~~~~~~~~ -Dropping dead code for a cyclic Strongly Connected Component is done -in a very simple way: - - the entire SCC is dropped if none of its binders are mentioned - in the body; otherwise the whole thing is kept. - -The key observation is that dead code elimination happens after -dependency analysis: so 'occAnalBind' processes SCCs instead of the -original term's binding groups. - -Thus 'occAnalBind' does indeed drop 'f' in an example like - - letrec f = ...g... - g = ...(...g...)... - in - ...g... - -when 'g' no longer uses 'f' at all (eg 'f' does not occur in a RULE in -'g'). 'occAnalBind' first consumes 'CyclicSCC g' and then it consumes -'AcyclicSCC f', where 'body_usage' won't contain 'f'. - ------------------------------------------------------------- -Note [Forming Rec groups] -~~~~~~~~~~~~~~~~~~~~~~~~~ -We put bindings {f = ef; g = eg } in a Rec group if "f uses g" -and "g uses f", no matter how indirectly. We do a SCC analysis -with an edge f -> g if "f uses g". - -More precisely, "f uses g" iff g should be in scope wherever f is. -That is, g is free in: - a) the rhs 'ef' - b) or the RHS of a rule for f (Note [Rules are extra RHSs]) - c) or the LHS or a rule for f (Note [Rule dependency info]) - -These conditions apply regardless of the activation of the RULE (eg it might be -inactive in this phase but become active later). Once a Rec is broken up -it can never be put back together, so we must be conservative. - -The principle is that, regardless of rule firings, every variable is -always in scope. - - * Note [Rules are extra RHSs] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ - A RULE for 'f' is like an extra RHS for 'f'. That way the "parent" - keeps the specialised "children" alive. If the parent dies - (because it isn't referenced any more), then the children will die - too (unless they are already referenced directly). - - To that end, we build a Rec group for each cyclic strongly - connected component, - *treating f's rules as extra RHSs for 'f'*. - More concretely, the SCC analysis runs on a graph with an edge - from f -> g iff g is mentioned in - (a) f's rhs - (b) f's RULES - These are rec_edges. - - Under (b) we include variables free in *either* LHS *or* RHS of - the rule. The former might seems silly, but see Note [Rule - dependency info]. So in Example [eftInt], eftInt and eftIntFB - will be put in the same Rec, even though their 'main' RHSs are - both non-recursive. - - * Note [Rule dependency info] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~ - The VarSet in a RuleInfo is used for dependency analysis in the - occurrence analyser. We must track free vars in *both* lhs and rhs. - Hence use of idRuleVars, rather than idRuleRhsVars in occAnalBind. - Why both? Consider - x = y - RULE f x = v+4 - Then if we substitute y for x, we'd better do so in the - rule's LHS too, so we'd better ensure the RULE appears to mention 'x' - as well as 'v' - - * Note [Rules are visible in their own rec group] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - We want the rules for 'f' to be visible in f's right-hand side. - And we'd like them to be visible in other functions in f's Rec - group. E.g. in Note [Specialisation rules] we want f' rule - to be visible in both f's RHS, and fs's RHS. - - This means that we must simplify the RULEs first, before looking - at any of the definitions. This is done by Simplify.simplRecBind, - when it calls addLetIdInfo. - ------------------------------------------------------------- -Note [Choosing loop breakers] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Loop breaking is surprisingly subtle. First read the section 4 of -"Secrets of the GHC inliner". This describes our basic plan. -We avoid infinite inlinings by choosing loop breakers, and -ensuring that a loop breaker cuts each loop. - -See also Note [Inlining and hs-boot files] in GHC.Core.ToIface, which -deals with a closely related source of infinite loops. - -Fundamentally, we do SCC analysis on a graph. For each recursive -group we choose a loop breaker, delete all edges to that node, -re-analyse the SCC, and iterate. - -But what is the graph? NOT the same graph as was used for Note -[Forming Rec groups]! In particular, a RULE is like an equation for -'f' that is *always* inlined if it is applicable. We do *not* disable -rules for loop-breakers. It's up to whoever makes the rules to make -sure that the rules themselves always terminate. See Note [Rules for -recursive functions] in GHC.Core.Opt.Simplify - -Hence, if - f's RHS (or its INLINE template if it has one) mentions g, and - g has a RULE that mentions h, and - h has a RULE that mentions f - -then we *must* choose f to be a loop breaker. Example: see Note -[Specialisation rules]. - -In general, take the free variables of f's RHS, and augment it with -all the variables reachable by RULES from those starting points. That -is the whole reason for computing rule_fv_env in occAnalBind. (Of -course we only consider free vars that are also binders in this Rec -group.) See also Note [Finding rule RHS free vars] - -Note that when we compute this rule_fv_env, we only consider variables -free in the *RHS* of the rule, in contrast to the way we build the -Rec group in the first place (Note [Rule dependency info]) - -Note that if 'g' has RHS that mentions 'w', we should add w to -g's loop-breaker edges. More concretely there is an edge from f -> g -iff - (a) g is mentioned in f's RHS `xor` f's INLINE rhs - (see Note [Inline rules]) - (b) or h is mentioned in f's RHS, and - g appears in the RHS of an active RULE of h - or a transitive sequence of active rules starting with h - -Why "active rules"? See Note [Finding rule RHS free vars] +********************************************************************* -} -Note that in Example [eftInt], *neither* eftInt *nor* eftIntFB is -chosen as a loop breaker, because their RHSs don't mention each other. -And indeed both can be inlined safely. - -Note again that the edges of the graph we use for computing loop breakers -are not the same as the edges we use for computing the Rec blocks. -That's why we compute - -- rec_edges for the Rec block analysis -- loop_breaker_nodes for the loop breaker analysis - - * Note [Finding rule RHS free vars] - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Consider this real example from Data Parallel Haskell - tagZero :: Array Int -> Array Tag - {-# INLINE [1] tagZeroes #-} - tagZero xs = pmap (\x -> fromBool (x==0)) xs - - {-# RULES "tagZero" [~1] forall xs n. - pmap fromBool = tagZero xs #-} - So tagZero's RHS mentions pmap, and pmap's RULE mentions tagZero. - However, tagZero can only be inlined in phase 1 and later, while - the RULE is only active *before* phase 1. So there's no problem. +type ImpRuleEdges = IdEnv [(Activation, VarSet)] + -- Mapping from a local Id 'f' to info about its IMP-RULES, + -- i.e. /local/ rules for an imported Id that mention 'f' on the LHS + -- We record (a) its Activation and (b) the RHS free vars + -- See Note [IMP-RULES: local rules for imported functions] - To make this work, we look for the RHS free vars only for - *active* rules. That's the reason for the occ_rule_act field - of the OccEnv. - - * Note [Weak loop breakers] - ~~~~~~~~~~~~~~~~~~~~~~~~~ - There is a last nasty wrinkle. Suppose we have - - Rec { f = f_rhs - RULE f [] = g - - h = h_rhs - g = h - ...more... - } - - Remember that we simplify the RULES before any RHS (see Note - [Rules are visible in their own rec group] above). - - So we must *not* postInlineUnconditionally 'g', even though - its RHS turns out to be trivial. (I'm assuming that 'g' is - not chosen as a loop breaker.) Why not? Because then we - drop the binding for 'g', which leaves it out of scope in the - RULE! - - Here's a somewhat different example of the same thing - Rec { g = h - ; h = ...f... - ; f = f_rhs - RULE f [] = g } - Here the RULE is "below" g, but we *still* can't postInlineUnconditionally - g, because the RULE for f is active throughout. So the RHS of h - might rewrite to h = ...g... - So g must remain in scope in the output program! +noImpRuleEdges :: ImpRuleEdges +noImpRuleEdges = emptyVarEnv - We "solve" this by: +lookupImpRules :: ImpRuleEdges -> Id -> [(Activation,VarSet)] +lookupImpRules imp_rule_edges bndr + = case lookupVarEnv imp_rule_edges bndr of + Nothing -> [] + Just vs -> vs + +impRulesScopeUsage :: [(Activation,VarSet)] -> UsageDetails +-- Variable mentioned in RHS of an IMP-RULE for the bndr, +-- whether active or not +impRulesScopeUsage imp_rules_info + = foldr add emptyDetails imp_rules_info + where + add (_,vs) usage = addManyOccs usage vs - Make g a "weak" loop breaker (OccInfo = IAmLoopBreaker True) - iff g is a "missing free variable" of the Rec group +impRulesActiveFvs :: (Activation -> Bool) -> VarSet + -> [(Activation,VarSet)] -> VarSet +impRulesActiveFvs is_active bndr_set vs + = foldr add emptyVarSet vs `intersectVarSet` bndr_set + where + add (act,vs) acc | is_active act = vs `unionVarSet` acc + | otherwise = acc - A "missing free variable" x is one that is mentioned in an RHS or - INLINE or RULE of a binding in the Rec group, but where the - dependency on x may not show up in the loop_breaker_nodes (see - note [Choosing loop breakers} above). +{- Note [IMP-RULES: local rules for imported functions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We quite often have + * A /local/ rule + * for an /imported/ function +like this: + foo x = blah + {-# RULE "map/foo" forall xs. map foo xs = xs #-} +We call them IMP-RULES. They are important in practice, and occur a +lot in the libraries. - A normal "strong" loop breaker has IAmLoopBreaker False. So +IMP-RULES are held in mg_rules of ModGuts, and passed in to +occurAnalysePgm. - Inline postInlineUnconditionally - strong IAmLoopBreaker False no no - weak IAmLoopBreaker True yes no - other yes yes +Main Invariant: - The **sole** reason for this kind of loop breaker is so that - postInlineUnconditionally does not fire. Ugh. (Typically it'll - inline via the usual callSiteInline stuff, so it'll be dead in the - next pass, so the main Ugh is the tiresome complication.) +* Throughout, we treat an IMP-RULE that mentions 'f' on its LHS + just like a RULE for f. -Note [Rules for imported functions] +Note [IMP-RULES: unavoidable loops] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this f = /\a. B.g a @@ -428,14 +206,28 @@ B.g. We could only spot such loops by exhaustively following unfoldings of C.h etc, in case we reach B.g, and hence (via the RULE) f. -Note that RULES for imported functions are important in practice; they -occur a lot in the libraries. - We regard this potential infinite loop as a *programmer* error. It's up the programmer not to write silly rules like RULE f x = f x and the example above is just a more complicated version. +Note [Specialising imported functions] (referred to from Specialise) +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For *automatically-generated* rules, the programmer can't be +responsible for the "programmer error" in Note [IMP-RULES: unavoidable +loops]. In particular, consider specialising a recursive function +defined in another module. If we specialise a recursive function B.g, +we get + g_spec = .....(B.g Int)..... + RULE B.g Int = g_spec +Here, g_spec doesn't look recursive, but when the rule fires, it +becomes so. And if B.g was mutually recursive, the loop might not be +as obvious as it is here. + +To avoid this, + * When specialising a function that is a loop breaker, + give a NOINLINE pragma to the specialised function + Note [Preventing loops due to imported functions rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider: @@ -501,70 +293,207 @@ And we are in an infinite loop again, except that this time the loop is producin infinitely large *term* (an unrolling of filter) and so the simplifier finally dies with "ticks exhausted" -Because of this problem, we make a small change in the occurrence analyser -designed to mark functions like "filter" as strong loop breakers on the basis that: - 1. The RHS of filter mentions the local function "filterFB" - 2. We have a rule which mentions "filterFB" on the LHS and "filter" on the RHS +SOLUTION: we treat the rule "filterList" as an extra rule for 'filterFB' +because it mentions 'filterFB' on the LHS. This is the Main Invariant +in Note [IMP-RULES: local rules for imported functions]. + +So, during loop-breaker analysis: + +- for each active RULE for a local function 'f' we add an edge bewteen + 'f' and the local FVs of the rule RHS + +- for each active RULE for an *imported* function we add dependency + edges between the *local* FVS of the rule LHS and the *local* FVS of + the rule RHS. + +Even with this extra hack we aren't always going to get things +right. For example, it might be that the rule LHS mentions an imported +Id, and another module has a RULE that can rewrite that imported Id to +one of our local Ids. + +Note [Plugin rules] +~~~~~~~~~~~~~~~~~~~ +Conal Elliott (#11651) built a GHC plugin that added some +BuiltinRules (for imported Ids) to the mg_rules field of ModGuts, to +do some domain-specific transformations that could not be expressed +with an ordinary pattern-matching CoreRule. But then we can't extract +the dependencies (in imp_rule_edges) from ru_rhs etc, because a +BuiltinRule doesn't have any of that stuff. + +So we simply assume that BuiltinRules have no dependencies, and filter +them out from the imp_rule_edges comprehension. + +Note [Glomming] +~~~~~~~~~~~~~~~ +RULES for imported Ids can make something at the top refer to +something at the bottom: + + foo = ...(B.f @Int)... + $sf = blah + RULE: B.f @Int = $sf + +Applying this rule makes foo refer to $sf, although foo doesn't appear to +depend on $sf. (And, as in Note [Rules for imported functions], the +dependency might be more indirect. For example, foo might mention C.t +rather than B.f, where C.t eventually inlines to B.f.) + +NOTICE that this cannot happen for rules whose head is a +locally-defined function, because we accurately track dependencies +through RULES. It only happens for rules whose head is an imported +function (B.f in the example above). + +Solution: + - When simplifying, bring all top level identifiers into + scope at the start, ignoring the Rec/NonRec structure, so + that when 'h' pops up in f's rhs, we find it in the in-scope set + (as the simplifier generally expects). This happens in simplTopBinds. + + - In the occurrence analyser, if there are any out-of-scope + occurrences that pop out of the top, which will happen after + firing the rule: f = \x -> h x + h = \y -> 3 + then just glom all the bindings into a single Rec, so that + the *next* iteration of the occurrence analyser will sort + them all out. This part happens in occurAnalysePgm. +-} + +{- +************************************************************************ +* * + Bindings +* * +************************************************************************ + +Note [Recursive bindings: the grand plan] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we come across a binding group + Rec { x1 = r1; ...; xn = rn } +we treat it like this (occAnalRecBind): + +1. Note [Forming Rec groups] + Occurrence-analyse each right hand side, and build a + "Details" for each binding to capture the results. + Wrap the details in a LetrecNode, ready for SCC analysis. + All this is done by makeNode. + +2. Do SCC-analysis on these Nodes: + - Each CyclicSCC will become a new Rec + - Each AcyclicSCC will become a new NonRec + The key property is that every free variable of a binding is + accounted for by the scope edges, so that when we are done + everything is still in scope. + +3. For each AcyclicSCC, just make a NonRec binding. + +4. For each CyclicSCC of the scope-edge SCC-analysis in (2), we + identify suitable loop-breakers to ensure that inlining terminates. + This is done by occAnalRec. + + 4a To do so we form a new set of Nodes, with the same details, but + different edges, the "loop-breaker nodes". The loop-breaker nodes + have both more and fewer dependencies than the scope edges + (see Note [Choosing loop breakers]) + + More edges: if f calls g, and g has an active rule that mentions h + then we add an edge from f -> h + + Fewer edges: we only include dependencies on active rules, on rule + RHSs (not LHSs) and if there is an INLINE pragma only + on the stable unfolding (and vice versa). The scope + edges must be much more inclusive. + + 4b. The "weak fvs" of a node are, by definition: + the scope fvs - the loop-breaker fvs + See Note [Weak loop breakers], and the nd_weak field of Details + +Note [Dead code] +~~~~~~~~~~~~~~~~ +Dropping dead code for a cyclic Strongly Connected Component is done +in a very simple way: + + the entire SCC is dropped if none of its binders are mentioned + in the body; otherwise the whole thing is kept. -So for each RULE for an *imported* function we are going to add -dependency edges between the *local* FVS of the rule LHS and the -*local* FVS of the rule RHS. We don't do anything special for RULES on -local functions because the standard occurrence analysis stuff is -pretty good at getting loop-breakerness correct there. +The key observation is that dead code elimination happens after +dependency analysis: so 'occAnalBind' processes SCCs instead of the +original term's binding groups. -It is important to note that even with this extra hack we aren't always going to get -things right. For example, it might be that the rule LHS mentions an imported Id, -and another module has a RULE that can rewrite that imported Id to one of our local -Ids. +Thus 'occAnalBind' does indeed drop 'f' in an example like -Note [Specialising imported functions] (referred to from Specialise) -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -BUT for *automatically-generated* rules, the programmer can't be -responsible for the "programmer error" in Note [Rules for imported -functions]. In particular, consider specialising a recursive function -defined in another module. If we specialise a recursive function B.g, -we get - g_spec = .....(B.g Int)..... - RULE B.g Int = g_spec -Here, g_spec doesn't look recursive, but when the rule fires, it -becomes so. And if B.g was mutually recursive, the loop might -not be as obvious as it is here. + letrec f = ...g... + g = ...(...g...)... + in + ...g... -To avoid this, - * When specialising a function that is a loop breaker, - give a NOINLINE pragma to the specialised function +when 'g' no longer uses 'f' at all (eg 'f' does not occur in a RULE in +'g'). 'occAnalBind' first consumes 'CyclicSCC g' and then it consumes +'AcyclicSCC f', where 'body_usage' won't contain 'f'. -Note [Glomming] -~~~~~~~~~~~~~~~ -RULES for imported Ids can make something at the top refer to something at the bottom: - f = \x -> B.g (q x) - h = \y -> 3 +------------------------------------------------------------ +Note [Forming Rec groups] +~~~~~~~~~~~~~~~~~~~~~~~~~ +The key point about the "Forming Rec groups" step is that it /preserves +scoping/. If 'x' is mentioned, it had better be bound somewhere. So if +we start with + Rec { f = ...h... + ; g = ...f... + ; h = ...f... } +we can split into SCCs + Rec { f = ...h... + ; h = ..f... } + NonRec { g = ...f... } + +We put bindings {f = ef; g = eg } in a Rec group if "f uses g" and "g +uses f", no matter how indirectly. We do a SCC analysis with an edge +f -> g if "f mentions g". That is, g is free in: + a) the rhs 'ef' + b) or the RHS of a rule for f, whether active or inactive + Note [Rules are extra RHSs] + c) or the LHS or a rule for f, whether active or inactive + Note [Rule dependency info] + d) the RHS of an /active/ local IMP-RULE + Note [IMP-RULES: local rules for imported functions] + +(b) and (c) apply regardless of the activation of the RULE, because even if +the rule is inactive its free variables must be bound. But (d) doesn't need +to worry about this because IMP-RULES are always notionally at the bottom +of the file. - RULE: B.g (q x) = h x + * Note [Rules are extra RHSs] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~ + A RULE for 'f' is like an extra RHS for 'f'. That way the "parent" + keeps the specialised "children" alive. If the parent dies + (because it isn't referenced any more), then the children will die + too (unless they are already referenced directly). -Applying this rule makes f refer to h, although f doesn't appear to -depend on h. (And, as in Note [Rules for imported functions], the -dependency might be more indirect. For example, f might mention C.t -rather than B.g, where C.t eventually inlines to B.g.) + So in Example [eftInt], eftInt and eftIntFB will be put in the + same Rec, even though their 'main' RHSs are both non-recursive. -NOTICE that this cannot happen for rules whose head is a -locally-defined function, because we accurately track dependencies -through RULES. It only happens for rules whose head is an imported -function (B.g in the example above). + We must also include inactive rules, so that their free vars + remain in scope. -Solution: - - When simplifying, bring all top level identifiers into - scope at the start, ignoring the Rec/NonRec structure, so - that when 'h' pops up in f's rhs, we find it in the in-scope set - (as the simplifier generally expects). This happens in simplTopBinds. + * Note [Rule dependency info] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~ + The VarSet in a RuleInfo is used for dependency analysis in the + occurrence analyser. We must track free vars in *both* lhs and rhs. + Hence use of idRuleVars, rather than idRuleRhsVars in occAnalBind. + Why both? Consider + x = y + RULE f x = v+4 + Then if we substitute y for x, we'd better do so in the + rule's LHS too, so we'd better ensure the RULE appears to mention 'x' + as well as 'v' - - In the occurrence analyser, if there are any out-of-scope - occurrences that pop out of the top, which will happen after - firing the rule: f = \x -> h x - h = \y -> 3 - then just glom all the bindings into a single Rec, so that - the *next* iteration of the occurrence analyser will sort - them all out. This part happens in occurAnalysePgm. + * Note [Rules are visible in their own rec group] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + We want the rules for 'f' to be visible in f's right-hand side. + And we'd like them to be visible in other functions in f's Rec + group. E.g. in Note [Specialisation rules] we want f' rule + to be visible in both f's RHS, and fs's RHS. + + This means that we must simplify the RULEs first, before looking + at any of the definitions. This is done by Simplify.simplRecBind, + when it calls addLetIdInfo. ------------------------------------------------------------ Note [Inline rules] @@ -724,6 +653,13 @@ propagate. This appears to be very rare in practice. TODO Perhaps we should gather statistics to be sure. +Note [Unfoldings and join points] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We assume that anything in an unfolding occurs multiple times, since +unfoldings are often copied (that's the whole point!). But we still +need to track tail calls for the purpose of finding join points. + + ------------------------------------------------------------ Note [Adjusting right-hand sides] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -794,45 +730,50 @@ occAnalNonRecBind env lvl imp_rule_edges bndr rhs body_usage = (body_usage, []) | otherwise -- It's mentioned in the body - = (body_usage' `andUDs` rhs_usage4, [NonRec final_bndr rhs']) + = (body_usage' `andUDs` rhs_usage, [NonRec final_bndr rhs']) where (body_usage', tagged_bndr) = tagNonRecBinder lvl body_usage bndr - occ = idOccInfo tagged_bndr + final_bndr = tagged_bndr `setIdUnfolding` unf' + `setIdSpecialisation` mkRuleInfo rules' + rhs_usage = rhs_uds `andUDs` unf_uds `andUDs` rule_uds -- Get the join info from the *new* decision -- See Note [Join points and unfoldings/rules] mb_join_arity = willBeJoinId_maybe tagged_bndr is_join_point = isJust mb_join_arity - final_bndr = tagged_bndr `setIdUnfolding` unf' - `setIdSpecialisation` mkRuleInfo rules' - + --------- Right hand side --------- env1 | is_join_point = env -- See Note [Join point RHSs] | certainly_inline = env -- See Note [Cascading inlines] | otherwise = rhsCtxt env -- See Note [Sources of one-shot information] rhs_env = env1 { occ_one_shots = argOneShots dmd } + (rhs_uds, rhs') = occAnalRhs rhs_env NonRecursive mb_join_arity rhs - (rhs_usage1, rhs') = occAnalRhs rhs_env mb_join_arity rhs - - -- Unfoldings + --------- Unfolding --------- -- See Note [Unfoldings and join points] unf = idUnfolding bndr - (unf_usage, unf') = occAnalUnfolding rhs_env mb_join_arity unf - rhs_usage2 = rhs_usage1 `andUDs` unf_usage + (unf_uds, unf') = occAnalUnfolding rhs_env NonRecursive mb_join_arity unf - -- Rules + --------- Rules --------- -- See Note [Rules are extra RHSs] and Note [Rule dependency info] - rules_w_uds = occAnalRules rhs_env mb_join_arity bndr - rule_uds = map (\(_, l, r) -> l `andUDs` r) rules_w_uds - rules' = map fstOf3 rules_w_uds - rhs_usage3 = foldr andUDs rhs_usage2 rule_uds - rhs_usage4 = case lookupVarEnv imp_rule_edges bndr of - Nothing -> rhs_usage3 - Just vs -> addManyOccs rhs_usage3 vs - -- See Note [Preventing loops due to imported functions rules] - + rules_w_uds = occAnalRules rhs_env mb_join_arity bndr + rules' = map fstOf3 rules_w_uds + imp_rule_uds = impRulesScopeUsage (lookupImpRules imp_rule_edges bndr) + -- imp_rule_uds: consider + -- h = ... + -- g = ... + -- RULE map g = h + -- Then we want to ensure that h is in scope everwhere + -- that g is (since the RULE might turn g into h), so + -- we make g mention h. + + rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds + add_rule_uds (_, l, r) uds = l `andUDs` r `andUDs` uds + + ---------- + occ = idOccInfo tagged_bndr certainly_inline -- See Note [Cascading inlines] = case occ of OneOcc { occ_in_lam = NotInsideLam, occ_n_br = 1 } @@ -846,13 +787,13 @@ occAnalNonRecBind env lvl imp_rule_edges bndr rhs body_usage ----------------- occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] -> UsageDetails -> (UsageDetails, [CoreBind]) +-- For a recursive group, we +-- * occ-analyse all the RHSs +-- * compute strongly-connected components +-- * feed those components to occAnalRec +-- See Note [Recursive bindings: the grand plan] occAnalRecBind env lvl imp_rule_edges pairs body_usage = foldr (occAnalRec rhs_env lvl) (body_usage, []) sccs - -- For a recursive group, we - -- * occ-analyse all the RHSs - -- * compute strongly-connected components - -- * feed those components to occAnalRec - -- See Note [Recursive bindings: the grand plan] where sccs :: [SCC Details] sccs = {-# SCC "occAnalBind.scc" #-} @@ -866,14 +807,6 @@ occAnalRecBind env lvl imp_rule_edges pairs body_usage bndr_set = mkVarSet bndrs rhs_env = env `addInScope` bndrs -{- -Note [Unfoldings and join points] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -We assume that anything in an unfolding occurs multiple times, since unfoldings -are often copied (that's the whole point!). But we still need to track tail -calls for the purpose of finding join points. --} ----------------------------- occAnalRec :: OccEnv -> TopLevelFlag @@ -893,8 +826,8 @@ occAnalRec _ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = rhs NonRec tagged_bndr rhs : binds) where (body_uds', tagged_bndr) = tagNonRecBinder lvl body_uds bndr - rhs_uds' = adjustRhsUsage (willBeJoinId_maybe tagged_bndr) NonRecursive - rhs_bndrs rhs_uds + rhs_uds' = adjustRhsUsage NonRecursive (willBeJoinId_maybe tagged_bndr) + rhs_bndrs rhs_uds -- The Rec case is the interesting one -- See Note [Recursive bindings: the grand plan] @@ -910,15 +843,14 @@ occAnalRec env lvl (CyclicSCC details_s) (body_uds, binds) (final_uds, Rec pairs : binds) where - bndrs = map nd_bndr details_s - bndr_set = mkVarSet bndrs + bndrs = map nd_bndr details_s ------------------------------ - -- See Note [Choosing loop breakers] for loop_breaker_nodes + -- Make the nodes for the loop-breaker analysis + -- See Note [Choosing loop breakers] for loop_breaker_nodes final_uds :: UsageDetails loop_breaker_nodes :: [LetrecNode] - (final_uds, loop_breaker_nodes) - = mkLoopBreakerNodes env lvl bndr_set body_uds details_s + (final_uds, loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s ------------------------------ weak_fvs :: VarSet @@ -927,8 +859,8 @@ occAnalRec env lvl (CyclicSCC details_s) (body_uds, binds) --------------------------- -- Now reconstruct the cycle pairs :: [(Id,CoreExpr)] - pairs | isEmptyVarSet weak_fvs = reOrderNodes 0 bndr_set weak_fvs loop_breaker_nodes [] - | otherwise = loopBreakNodes 0 bndr_set weak_fvs loop_breaker_nodes [] + pairs | isEmptyVarSet weak_fvs = reOrderNodes 0 weak_fvs loop_breaker_nodes [] + | otherwise = loopBreakNodes 0 weak_fvs loop_breaker_nodes [] -- If weak_fvs is empty, the loop_breaker_nodes will include -- all the edges in the original scope edges [remember, -- weak_fvs is the difference between scope edges and @@ -937,14 +869,151 @@ occAnalRec env lvl (CyclicSCC details_s) (body_uds, binds) -- exactly that case ------------------------------------------------------------------- --- Loop breaking ------------------------------------------------------------------- +{- ********************************************************************* +* * + Loop breaking +* * +********************************************************************* -} + +{- Note [Choosing loop breakers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Loop breaking is surprisingly subtle. First read the section 4 of +"Secrets of the GHC inliner". This describes our basic plan. +We avoid infinite inlinings by choosing loop breakers, and +ensuring that a loop breaker cuts each loop. + +See also Note [Inlining and hs-boot files] in GHC.Core.ToIface, which +deals with a closely related source of infinite loops. + +Fundamentally, we do SCC analysis on a graph. For each recursive +group we choose a loop breaker, delete all edges to that node, +re-analyse the SCC, and iterate. + +But what is the graph? NOT the same graph as was used for Note +[Forming Rec groups]! In particular, a RULE is like an equation for +'f' that is *always* inlined if it is applicable. We do *not* disable +rules for loop-breakers. It's up to whoever makes the rules to make +sure that the rules themselves always terminate. See Note [Rules for +recursive functions] in GHC.Core.Opt.Simplify + +Hence, if + f's RHS (or its INLINE template if it has one) mentions g, and + g has a RULE that mentions h, and + h has a RULE that mentions f + +then we *must* choose f to be a loop breaker. Example: see Note +[Specialisation rules]. + +In general, take the free variables of f's RHS, and augment it with +all the variables reachable by RULES from those starting points. That +is the whole reason for computing rule_fv_env in occAnalBind. (Of +course we only consider free vars that are also binders in this Rec +group.) See also Note [Finding rule RHS free vars] + +Note that when we compute this rule_fv_env, we only consider variables +free in the *RHS* of the rule, in contrast to the way we build the +Rec group in the first place (Note [Rule dependency info]) + +Note that if 'g' has RHS that mentions 'w', we should add w to +g's loop-breaker edges. More concretely there is an edge from f -> g +iff + (a) g is mentioned in f's RHS `xor` f's INLINE rhs + (see Note [Inline rules]) + (b) or h is mentioned in f's RHS, and + g appears in the RHS of an active RULE of h + or a /transitive sequence/ of /active rules/ starting with h + +Why "active rules"? See Note [Finding rule RHS free vars] + +Why "transitive sequence"? Because active rules apply +unconditionallly, without checking loop-breaker-ness. +See Note [Loop breaker dependencies]. + +Note that in Example [eftInt], *neither* eftInt *nor* eftIntFB is +chosen as a loop breaker, because their RHSs don't mention each other. +And indeed both can be inlined safely. + +Note again that the edges of the graph we use for computing loop breakers +are not the same as the edges we use for computing the Rec blocks. +That's why we use + +- makeNode for the Rec block analysis +- makeLoopBreakerNodes for the loop breaker analysis + + * Note [Finding rule RHS free vars] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + Consider this real example from Data Parallel Haskell + tagZero :: Array Int -> Array Tag + {-# INLINE [1] tagZeroes #-} + tagZero xs = pmap (\x -> fromBool (x==0)) xs + + {-# RULES "tagZero" [~1] forall xs n. + pmap fromBool = tagZero xs #-} + So tagZero's RHS mentions pmap, and pmap's RULE mentions tagZero. + However, tagZero can only be inlined in phase 1 and later, while + the RULE is only active *before* phase 1. So there's no problem. + + To make this work, we look for the RHS free vars only for + *active* rules. That's the reason for the occ_rule_act field + of the OccEnv. + + * Note [Weak loop breakers] + ~~~~~~~~~~~~~~~~~~~~~~~~~ + There is a last nasty wrinkle. Suppose we have + + Rec { f = f_rhs + RULE f [] = g + + h = h_rhs + g = h + ...more... + } + + Remember that we simplify the RULES before any RHS (see Note + [Rules are visible in their own rec group] above). + + So we must *not* postInlineUnconditionally 'g', even though + its RHS turns out to be trivial. (I'm assuming that 'g' is + not chosen as a loop breaker.) Why not? Because then we + drop the binding for 'g', which leaves it out of scope in the + RULE! + + Here's a somewhat different example of the same thing + Rec { g = h + ; h = ...f... + ; f = f_rhs + RULE f [] = g } + Here the RULE is "below" g, but we *still* can't postInlineUnconditionally + g, because the RULE for f is active throughout. So the RHS of h + might rewrite to h = ...g... + So g must remain in scope in the output program! + + We "solve" this by: + + Make g a "weak" loop breaker (OccInfo = IAmLoopBreaker True) + iff g is a "missing free variable" of the Rec group + + A "missing free variable" x is one that is mentioned in an RHS or + INLINE or RULE of a binding in the Rec group, but where the + dependency on x may not show up in the loop_breaker_nodes (see + note [Choosing loop breakers} above). + + A normal "strong" loop breaker has IAmLoopBreaker False. So + + Inline postInlineUnconditionally + strong IAmLoopBreaker False no no + weak IAmLoopBreaker True yes no + other yes yes + + The **sole** reason for this kind of loop breaker is so that + postInlineUnconditionally does not fire. Ugh. (Typically it'll + inline via the usual callSiteInline stuff, so it'll be dead in the + next pass, so the main Ugh is the tiresome complication.) +-} type Binding = (Id,CoreExpr) loopBreakNodes :: Int - -> VarSet -- All binders -> VarSet -- Binders whose dependencies may be "missing" -- See Note [Weak loop breakers] -> [LetrecNode] @@ -968,7 +1037,7 @@ recording inlinings for any Ids which aren't marked as "no-inline" as it goes. -} -- Return the bindings sorted into a plausible order, and marked with loop breakers. -loopBreakNodes depth bndr_set weak_fvs nodes binds +loopBreakNodes depth weak_fvs nodes binds = -- pprTrace "loopBreakNodes" (ppr nodes) $ go (stronglyConnCompFromEdgedVerticesUniqR nodes) where @@ -977,20 +1046,20 @@ loopBreakNodes depth bndr_set weak_fvs nodes binds loop_break_scc scc binds = case scc of - AcyclicSCC node -> mk_non_loop_breaker weak_fvs node : binds - CyclicSCC nodes -> reOrderNodes depth bndr_set weak_fvs nodes binds + AcyclicSCC node -> nodeBinding (mk_non_loop_breaker weak_fvs) node : binds + CyclicSCC nodes -> reOrderNodes depth weak_fvs nodes binds ---------------------------------- -reOrderNodes :: Int -> VarSet -> VarSet -> [LetrecNode] -> [Binding] -> [Binding] +reOrderNodes :: Int -> VarSet -> [LetrecNode] -> [Binding] -> [Binding] -- Choose a loop breaker, mark it no-inline, -- and call loopBreakNodes on the rest -reOrderNodes _ _ _ [] _ = panic "reOrderNodes" -reOrderNodes _ _ _ [node] binds = mk_loop_breaker node : binds -reOrderNodes depth bndr_set weak_fvs (node : nodes) binds +reOrderNodes _ _ [] _ = panic "reOrderNodes" +reOrderNodes _ _ [node] binds = nodeBinding mk_loop_breaker node : binds +reOrderNodes depth weak_fvs (node : nodes) binds = -- pprTrace "reOrderNodes" (vcat [ text "unchosen" <+> ppr unchosen -- , text "chosen" <+> ppr chosen_nodes ]) $ - loopBreakNodes new_depth bndr_set weak_fvs unchosen $ - (map mk_loop_breaker chosen_nodes ++ binds) + loopBreakNodes new_depth weak_fvs unchosen $ + (map (nodeBinding mk_loop_breaker) chosen_nodes ++ binds) where (chosen_nodes, unchosen) = chooseLoopBreaker approximate_lb (nd_score (node_payload node)) @@ -1002,20 +1071,24 @@ reOrderNodes depth bndr_set weak_fvs (node : nodes) binds -- After two iterations (d=0, d=1) give up -- and approximate, returning to d=0 -mk_loop_breaker :: LetrecNode -> Binding -mk_loop_breaker (node_payload -> ND { nd_bndr = bndr, nd_rhs = rhs}) - = (bndr `setIdOccInfo` strongLoopBreaker { occ_tail = tail_info }, rhs) +nodeBinding :: (Id -> Id) -> LetrecNode -> Binding +nodeBinding set_id_occ (node_payload -> ND { nd_bndr = bndr, nd_rhs = rhs}) + = (set_id_occ bndr, rhs) + +mk_loop_breaker :: Id -> Id +mk_loop_breaker bndr + = bndr `setIdOccInfo` occ' where + occ' = strongLoopBreaker { occ_tail = tail_info } tail_info = tailCallInfo (idOccInfo bndr) -mk_non_loop_breaker :: VarSet -> LetrecNode -> Binding +mk_non_loop_breaker :: VarSet -> Id -> Id -- See Note [Weak loop breakers] -mk_non_loop_breaker weak_fvs (node_payload -> ND { nd_bndr = bndr - , nd_rhs = rhs}) - | bndr `elemVarSet` weak_fvs = (setIdOccInfo bndr occ', rhs) - | otherwise = (bndr, rhs) +mk_non_loop_breaker weak_fvs bndr + | bndr `elemVarSet` weak_fvs = setIdOccInfo bndr occ' + | otherwise = bndr where - occ' = weakLoopBreaker { occ_tail = tail_info } + occ' = weakLoopBreaker { occ_tail = tail_info } tail_info = tailCallInfo (idOccInfo bndr) ---------------------------------- @@ -1178,11 +1251,6 @@ ToDo: try using the occurrence info for the inline'd binder. ************************************************************************ -} -type ImpRuleEdges = IdEnv IdSet -- Mapping from FVs of imported RULE LHSs to RHS FVs - -noImpRuleEdges :: ImpRuleEdges -noImpRuleEdges = emptyVarEnv - type LetrecNode = Node Unique Details -- Node comes from Digraph -- The Unique key is gotten from the Id data Details @@ -1209,7 +1277,8 @@ data Details -- dependencies might not be respected by loop_breaker_nodes -- See Note [Weak loop breakers] - , nd_active_rule_fvs :: IdSet -- Free variables of the RHS of active RULES + , nd_active_rule_fvs :: IdSet -- Variables bound in this Rec group that are free + -- in the RHS of an active rule for this bndr , nd_score :: NodeScore } @@ -1220,7 +1289,7 @@ instance Outputable Details where , text "uds =" <+> ppr (nd_uds nd) , text "inl =" <+> ppr (nd_inl nd) , text "weak =" <+> ppr (nd_weak nd) - , text "rule =" <+> ppr (nd_active_rule_fvs nd) + , text "rule_rvs =" <+> ppr (nd_active_rule_fvs nd) , text "score =" <+> ppr (nd_score nd) ]) @@ -1241,7 +1310,9 @@ makeNode :: OccEnv -> ImpRuleEdges -> VarSet -> (Var, CoreExpr) -> LetrecNode -- See Note [Recursive bindings: the grand plan] makeNode env imp_rule_edges bndr_set (bndr, rhs) - = DigraphNode details (varUnique bndr) (nonDetKeysUniqSet node_fvs) + = DigraphNode { node_payload = details + , node_key = varUnique bndr + , node_dependencies = nonDetKeysUniqSet node_fvs } -- It's OK to use nonDetKeysUniqSet here as stronglyConnCompFromEdgedVerticesR -- is still deterministic with edges in nondeterministic order as -- explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed. @@ -1249,7 +1320,7 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) details = ND { nd_bndr = bndr' , nd_rhs = rhs' , nd_rhs_bndrs = bndrs' - , nd_uds = rhs_usage3 + , nd_uds = rhs_usage , nd_inl = inl_fvs , nd_weak = node_fvs `minusVarSet` inl_fvs , nd_active_rule_fvs = active_rule_fvs @@ -1258,6 +1329,11 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) bndr' = bndr `setIdUnfolding` unf' `setIdSpecialisation` mkRuleInfo rules' + rhs_usage = rhs_uds `andUDs` unf_uds `andUDs` rule_uds + -- Note [Rules are extra RHSs] + -- Note [Rule dependency info] + node_fvs = udFreeVars bndr_set rhs_usage + -- Get join point info from the *current* decision -- We don't know what the new decision will be! -- Using the old decision at least allows us to @@ -1265,66 +1341,68 @@ makeNode env imp_rule_edges bndr_set (bndr, rhs) -- See Note [Join points and unfoldings/rules] mb_join_arity = isJoinId_maybe bndr + --------- Right hand side --------- -- Constructing the edges for the main Rec computation -- See Note [Forming Rec groups] - (bndrs, body) = collectBinders rhs - rhs_env = rhsCtxt env - (rhs_usage1, bndrs', body') = occAnalLamOrRhs rhs_env bndrs body - rhs' = mkLams bndrs' body' - rhs_usage3 = foldr andUDs rhs_usage1 rule_uds - `andUDs` unf_uds - -- Note [Rules are extra RHSs] - -- Note [Rule dependency info] - node_fvs = udFreeVars bndr_set rhs_usage3 + -- Do not use occAnalRhs because we don't yet know + -- the final answer for mb_join_arity + (bndrs, body) = collectBinders rhs + rhs_env = rhsCtxt env + (rhs_uds, bndrs', body') = occAnalLamOrRhs rhs_env bndrs body + rhs' = mkLams bndrs' body' + + --------- Unfolding --------- + -- See Note [Unfoldings and join points] + unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness + -- here because that is what we are setting! + (unf_uds, unf') = occAnalUnfolding rhs_env Recursive mb_join_arity unf + inl_uds | isStableUnfolding unf = unf_uds + | otherwise = rhs_uds + inl_fvs = udFreeVars bndr_set inl_uds + -- inl_fvs: the vars that would become free if the function was inlined; + -- usually that means the RHS, unless the unfolding is a stable one. + -- Note: We could do this only for functions with an *active* unfolding + -- (returning emptyVarSet for an inactive one), but is_active + -- isn't the right thing (it tells about RULE activation), + -- so we'd need more plumbing - -- Finding the free variables of the rules - is_active = occ_rule_act env :: Activation -> Bool + --------- IMP-RULES -------- + is_active = occ_rule_act env :: Activation -> Bool + imp_rule_info = lookupImpRules imp_rule_edges bndr + imp_rule_uds = impRulesScopeUsage imp_rule_info + imp_rule_fvs = impRulesActiveFvs is_active bndr_set imp_rule_info + + --------- All rules -------- rules_w_uds :: [(CoreRule, UsageDetails, UsageDetails)] rules_w_uds = occAnalRules rhs_env mb_join_arity bndr + rules' = map fstOf3 rules_w_uds - rules' = map fstOf3 rules_w_uds - - rules_w_rhs_fvs :: [(Activation, VarSet)] -- Find the RHS fvs - rules_w_rhs_fvs = maybe id (\ids -> ((AlwaysActive, ids):)) - (lookupVarEnv imp_rule_edges bndr) - -- See Note [Preventing loops due to imported functions rules] - [ (ru_act rule, udFreeVars bndr_set rhs_uds) - | (rule, _, rhs_uds) <- rules_w_uds ] - rule_uds = map (\(_, l, r) -> l `andUDs` r) rules_w_uds - active_rule_fvs = unionVarSets [fvs | (a,fvs) <- rules_w_rhs_fvs - , is_active a] + rule_uds = foldr add_rule_uds imp_rule_uds rules_w_uds + add_rule_uds (_, l, r) uds = l `andUDs` r `andUDs` uds - -- Finding the usage details of the INLINE pragma (if any) - unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness - -- here because that is what we are setting! - (unf_uds, unf') = occAnalUnfolding rhs_env mb_join_arity unf + active_rule_fvs = foldr add_active_rule imp_rule_fvs rules_w_uds + add_active_rule (rule, _, rhs_uds) fvs + | is_active (ruleActivation rule) + = udFreeVars bndr_set rhs_uds `unionVarSet` fvs + | otherwise + = fvs - -- Find the "nd_inl" free vars; for the loop-breaker phase - -- These are the vars that would become free if the function - -- was inlinined; usually that means the RHS, unless the - -- unfolding is a stable one. - -- Note: We could do this only for functions with an *active* unfolding - -- (returning emptyVarSet for an inactive one), but is_active - -- isn't the right thing (it tells about RULE activation), - -- so we'd need more plumbing - inl_fvs | isStableUnfolding unf = udFreeVars bndr_set unf_uds - | otherwise = udFreeVars bndr_set rhs_usage1 mkLoopBreakerNodes :: OccEnv -> TopLevelFlag - -> VarSet -> UsageDetails -- for BODY of let -> [Details] -> (UsageDetails, -- adjusted [LetrecNode]) --- Does four things +-- This function primarily creates the Nodes for the +-- loop-breaker SCC analysis. More specifically: -- a) tag each binder with its occurrence info -- b) add a NodeScore to each node -- c) make a Node with the right dependency edges for -- the loop-breaker SCC analysis -- d) adjust each RHS's usage details according to -- the binder's (new) shotness and join-point-hood -mkLoopBreakerNodes env lvl bndr_set body_uds details_s +mkLoopBreakerNodes env lvl body_uds details_s = (final_uds, zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') where (final_uds, bndrs') @@ -1334,28 +1412,46 @@ mkLoopBreakerNodes env lvl bndr_set body_uds details_s <- details_s ] mk_lb_node nd@(ND { nd_bndr = old_bndr, nd_inl = inl_fvs }) new_bndr - = DigraphNode nd' (varUnique old_bndr) (nonDetKeysUniqSet lb_deps) + = DigraphNode { node_payload = new_nd + , node_key = varUnique old_bndr + , node_dependencies = nonDetKeysUniqSet lb_deps } -- It's OK to use nonDetKeysUniqSet here as -- stronglyConnCompFromEdgedVerticesR is still deterministic with edges -- in nondeterministic order as explained in -- Note [Deterministic SCC] in GHC.Data.Graph.Directed. where - nd' = nd { nd_bndr = new_bndr, nd_score = score } - score = nodeScore env new_bndr lb_deps nd + new_nd = nd { nd_bndr = new_bndr, nd_score = score } + score = nodeScore env new_bndr lb_deps nd lb_deps = extendFvs_ rule_fv_env inl_fvs - + -- See Note [Loop breaker dependencies] rule_fv_env :: IdEnv IdSet - -- Maps a variable f to the variables from this group - -- mentioned in RHS of active rules for f - -- Domain is *subset* of bound vars (others have no rule fvs) - rule_fv_env = transClosureFV (mkVarEnv init_rule_fvs) - init_rule_fvs -- See Note [Finding rule RHS free vars] - = [ (b, trimmed_rule_fvs) - | ND { nd_bndr = b, nd_active_rule_fvs = rule_fvs } <- details_s - , let trimmed_rule_fvs = rule_fvs `intersectVarSet` bndr_set - , not (isEmptyVarSet trimmed_rule_fvs) ] + -- Maps a variable f to the variables from this group + -- reachable by a sequence of RULES starting with f + -- Domain is *subset* of bound vars (others have no rule fvs) + -- See Note [Finding rule RHS free vars] + -- Why transClosureFV? See Note [Loop breaker dependencies] + rule_fv_env = transClosureFV $ mkVarEnv $ + [ (b, rule_fvs) + | ND { nd_bndr = b, nd_active_rule_fvs = rule_fvs } <- details_s + , not (isEmptyVarSet rule_fvs) ] + +{- Note [Loop breaker dependencies] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The loop breaker dependencies of x in a recursive +group { f1 = e1; ...; fn = en } are: +- The "inline free variables" of f: the fi free in + either f's unfolding (if f has a stable unfolding) + of f's RHS (if not) + +- Any fi reachable from those inline free variables by a sequence + of RULE rewrites. Remember, rule rewriting is not affected + by fi being a loop breaker, so we have to take the transitive + closure in case f is the only possible loop breaker in the loop. + + Hence rule_fv_env. We need only account for /active/ rules. +-} ------------------------------------------ nodeScore :: OccEnv @@ -1567,29 +1663,31 @@ Hence the is_lb field of NodeScore ************************************************************************ -} -occAnalRhs :: OccEnv -> Maybe JoinArity +occAnalRhs :: OccEnv -> RecFlag -> Maybe JoinArity -> CoreExpr -- RHS -> (UsageDetails, CoreExpr) -occAnalRhs env mb_join_arity rhs +occAnalRhs env is_rec mb_join_arity rhs = case occAnalLamOrRhs env bndrs body of { (body_usage, bndrs', body') -> - let rhs' = mkLams (markJoinOneShots mb_join_arity bndrs') body' + let final_bndrs | isRec is_rec = bndrs' + | otherwise = markJoinOneShots mb_join_arity bndrs' -- For a /non-recursive/ join point we can mark all -- its join-lambda as one-shot; and it's a good idea to do so -- Final adjustment - rhs_usage = adjustRhsUsage mb_join_arity NonRecursive bndrs' body_usage + rhs_usage = adjustRhsUsage is_rec mb_join_arity final_bndrs body_usage - in (rhs_usage, rhs') } + in (rhs_usage, mkLams final_bndrs body') } where (bndrs, body) = collectBinders rhs occAnalUnfolding :: OccEnv + -> RecFlag -> Maybe JoinArity -- See Note [Join points and unfoldings/rules] -> Unfolding -> (UsageDetails, Unfolding) -- Occurrence-analyse a stable unfolding; -- discard a non-stable one altogether. -occAnalUnfolding env mb_join_arity unf +occAnalUnfolding env is_rec mb_join_arity unf = case unf of unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src }) | isStableSource src -> (usage, unf') @@ -1600,7 +1698,7 @@ occAnalUnfolding env mb_join_arity unf -- to guide its decisions. It's ok to leave un-substituted -- expressions in the tree because all the variables that were in -- scope remain in scope; there is no cloning etc. - (usage, rhs') = occAnalRhs env mb_join_arity rhs + (usage, rhs') = occAnalRhs env is_rec mb_join_arity rhs unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] | otherwise = unf { uf_tmpl = rhs' } @@ -1897,7 +1995,7 @@ occAnalApp env (Var fun, args, ticks) -- This caused #18296 | fun `hasKey` runRWKey , [t1, t2, arg] <- args - , let (usage, arg') = occAnalRhs env (Just 1) arg + , let (usage, arg') = occAnalRhs env NonRecursive (Just 1) arg = (usage, mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) occAnalApp env (Var fun, args, ticks) @@ -2233,6 +2331,7 @@ addAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv addAppCtxt env@(OccEnv { occ_one_shots = ctxt }) args = env { occ_one_shots = replicate (valArgCount args) OneShotLam ++ ctxt } +-------------------- transClosureFV :: VarEnv VarSet -> VarEnv VarSet -- If (f,g), (g,h) are in the input, then (f,h) is in the output -- as well as (f,g), (g,h) @@ -2643,7 +2742,10 @@ v `usedIn` ud = isExportedId v || v `elemVarEnv` ud_env ud udFreeVars :: VarSet -> UsageDetails -> VarSet -- Find the subset of bndrs that are mentioned in uds -udFreeVars bndrs ud = restrictUniqSetToUFM bndrs (ud_env ud) +udFreeVars bndrs ud = restrictFreeVars bndrs (ud_env ud) + +restrictFreeVars :: VarSet -> OccInfoEnv -> VarSet +restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs {- Note [Do not mark CoVars as dead] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2712,20 +2814,20 @@ flattenUsageDetails ud ------------------- -- See Note [Adjusting right-hand sides] -adjustRhsUsage :: Maybe JoinArity -> RecFlag +adjustRhsUsage :: RecFlag -> Maybe JoinArity -> [CoreBndr] -- Outer lambdas, AFTER occ anal -> UsageDetails -- From body of lambda -> UsageDetails -adjustRhsUsage mb_join_arity rec_flag bndrs usage - = markAllInsideLamIf (not one_shot) $ +adjustRhsUsage is_rec mb_join_arity bndrs usage + = markAllInsideLamIf (not one_shot) $ markAllNonTailIf (not exact_join) $ usage where one_shot = case mb_join_arity of Just join_arity - | isRec rec_flag -> False - | otherwise -> all isOneShotBndr (drop join_arity bndrs) - Nothing -> all isOneShotBndr bndrs + | isRec is_rec -> False + | otherwise -> all isOneShotBndr (drop join_arity bndrs) + Nothing -> all isOneShotBndr bndrs exact_join = exactJoin mb_join_arity bndrs @@ -2806,7 +2908,7 @@ tagRecBinders lvl body_uds triples -- join-point-hood decision rhs_udss' = map adjust triples adjust (bndr, rhs_uds, rhs_bndrs) - = adjustRhsUsage mb_join_arity Recursive rhs_bndrs rhs_uds + = adjustRhsUsage Recursive mb_join_arity rhs_bndrs rhs_uds where -- Can't use willBeJoinId_maybe here because we haven't tagged the -- binder yet (the tag depends on these adjustments!) ===================================== testsuite/tests/simplCore/should_compile/T18603.hs ===================================== @@ -0,0 +1,29 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Test where + +import GHC.Base (build, foldr, id, Maybe(..)) + +catMaybes :: [Maybe a] -> [a] +catMaybes = mapMaybe id + +mapMaybe :: (a -> Maybe b) -> [a] -> [b] +mapMaybe _ [] = [] +mapMaybe f (x:xs) = + let rs = mapMaybe f xs in + case f x of + Nothing -> rs + Just r -> r:rs +{-# NOINLINE [1] mapMaybe #-} + +{-# RULES +"mapMaybe" [~1] forall f xs. mapMaybe f xs + = build (\c n -> foldr (mapMaybeFB c f) n xs) +"mapMaybeList" [1] forall f. foldr (mapMaybeFB (:) f) [] = mapMaybe f + #-} + +{-# INLINE [0] mapMaybeFB #-} -- See Note [Inline FB functions] in GHC.List +mapMaybeFB :: (b -> r -> r) -> (a -> Maybe b) -> a -> r -> r +mapMaybeFB cons f x next = case f x of + Nothing -> next + Just r -> cons r next ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -333,3 +333,4 @@ test('T18347', normal, compile, ['-dcore-lint -O']) test('T18355', [ grep_errmsg(r'OneShot') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T18399', normal, compile, ['-dcore-lint -O']) test('T18589', normal, compile, ['-dcore-lint -O']) +test('T18603', normal, compile, ['-dcore-lint -O']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b2531f680c4d8e034d0b1936ef975648a2b4462 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3b2531f680c4d8e034d0b1936ef975648a2b4462 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 16:05:34 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 09 Sep 2020 12:05:34 -0400 Subject: [Git][ghc/ghc][wip/T18126] 3 commits: Implement Quick Look impredicativity Message-ID: <5f58fd4e4ffca_80b3f849424815c112425cc@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: 7192b723 by Simon Peyton Jones at 2020-09-09T17:05:06+01:00 Implement Quick Look impredicativity This patch implements Quick Look impredicativity (#18126), sticking very closely to the design in A quick look at impredicativity, Serrano et al, ICFP 2020 The main change is that a big chunk of GHC.Tc.Gen.Expr has been extracted to two new modules GHC.Tc.Gen.App GHC.Tc.Gen.Head which deal with typechecking n-ary applications, and the head of such applications, respectively. Both contain a good deal of documentation. Three other loosely-related changes are in this patch: * I implemented (partly by accident) point (2) of the accepted GHC proposal "Clean up printing of foralls", namely https://github.com/ghc-proposals/ghc-proposals/blob/ master/proposals/0179-printing-foralls.rst In particular, see Note [TcRnExprMode] in GHC.Tc.Module - :type instantiates /inferred/, but not /specified/, quantifiers - :type +d instantiates /all/ quantifiers - :type +v is killed off * HsRecFld (which the renamer introduces for record field selectors), is now preserved by the typechecker, rather than being rewritten back to HsVar. This is more uniform, and turned out to be more convenient in the new scheme of things. * The GHCi debugger uses a non-standard unification that allows the unification variables to unify with polytypes. We used to hack this by using ImpredicativeTypes, but that doesn't work anymore so I introduces RuntimeUnkTv. See Note [RuntimeUnkTv] in GHC.Runtime.Heap.Inspect WARNING: this patch won't validate on its own. It was too hard to fully disentangle it from the following patch, on type errors and kind generalisation. Changes to tests * Fixes #9730 (test added) * Fixes #7026 (test added) * Fixes most of #8808, except function `g2'` which uses a section (which doesn't play with QL yet -- see #18126) Test added * Fixes #1330. NB Church1.hs subsumes Church2.hs, which is now deleted * Fixes #17332 (test added) * Fixes #4295 * This patch makes typecheck/should_run/T7861 fail. But that turns out to be a pre-existing bug: #18467. So I have just made T7861 into expect_broken(18467) - - - - - be4e8e8c by Simon Peyton Jones at 2020-09-09T17:05:06+01:00 Improve kind generalisation, error messages This patch does two things: * It refactors GHC.Tc.Errors a bit. In debugging Quick Look I was forced to look in detail at error messages, and ended up doing a bit of refactoring, esp in mkTyVarEqErr'. It's still quite a mess, but a bit better, I think. * It makes a significant improvement to the kind checking of type and class declarations. Specifically, we now ensure that if kind checking fails with an unsolved constraint, all the skolems are in scope. That wasn't the case before, which led to some obscure error messages; and occasional failures with "no skolem info" (eg #16245). Both of these, and the main Quick Look patch itself, affect a /lot/ of error messages, as you can see from the number of files changed. I've checked them all; I think they are as good or better than before. Smaller things * I documented the various instances of VarBndr better. See Note [The VarBndr tyep and its uses] in GHC.Types.Var * Renamed GHC.Tc.Solver.simpl_top to simplifyTopWanteds * A bit of refactoring in bindExplicitTKTele, to avoid the footwork with Either. Simpler now. * Move promoteTyVar from GHC.Tc.Solver to GHC.Tc.Utils.TcMType Fixes #16245 (comment 211369), memorialised as typeecheck/polykinds/T16245a - - - - - f45b94dd by GHC GitLab CI at 2020-09-09T17:05:06+01:00 Bump haddock submodule Accounts for spurious changes in the output of hypsrc-test. - - - - - 19 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Tc/Deriv/Generate.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - + compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Arrow.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Gen/Expr.hs-boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9f6ba7e02a5d8a0e5809eea2566df1e3943e8fa...f45b94dd9cf698f117e1bc0dd56f3d343cf7c869 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f9f6ba7e02a5d8a0e5809eea2566df1e3943e8fa...f45b94dd9cf698f117e1bc0dd56f3d343cf7c869 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 16:08:28 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 12:08:28 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump Win32 submodule to 2.9.0.0 Message-ID: <5f58fdfc60745_80b3f849424815c112439c6@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: da1ec18b by Ben Gamari at 2020-09-09T12:08:20-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 5 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - libraries/Cabal - libraries/directory - utils/ghc-cabal/ghc-cabal.cabal Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -77,7 +77,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else if flag(terminfo) Build-Depends: terminfo == 0.4.* ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -45,7 +45,7 @@ Executable ghc ghc == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else Build-Depends: unix >= 2.7 && < 2.9 @@ -102,4 +102,4 @@ Executable ghc Default-Extensions: NoImplicitPrelude , ScopedTypeVariables - , BangPatterns \ No newline at end of file + , BangPatterns ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 32dad5c1cf70d65ecb93b0ec214445cf9c9f6615 +Subproject commit 2d8a1b60ae409291585b647be8f02bc42b23cbbb ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3d9ca6edc0703860829ab3210db78bb4c4ff72b9 +Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e ===================================== utils/ghc-cabal/ghc-cabal.cabal ===================================== @@ -21,6 +21,6 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 3.0 && < 3.4, + Cabal >= 3.0 && < 3.5, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da1ec18b575ec3d7d748290626d6ae21e4a9a511 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/da1ec18b575ec3d7d748290626d6ae21e4a9a511 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 16:10:25 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Wed, 09 Sep 2020 12:10:25 -0400 Subject: [Git][ghc/ghc][wip/T18126] 2 commits: Improve kind generalisation, error messages Message-ID: <5f58fe7115313_80b76dca9811244319@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18126 at Glasgow Haskell Compiler / GHC Commits: ea097e5f by Simon Peyton Jones at 2020-09-09T17:07:54+01:00 Improve kind generalisation, error messages This patch does two things: * It refactors GHC.Tc.Errors a bit. In debugging Quick Look I was forced to look in detail at error messages, and ended up doing a bit of refactoring, esp in mkTyVarEqErr'. It's still quite a mess, but a bit better, I think. * It makes a significant improvement to the kind checking of type and class declarations. Specifically, we now ensure that if kind checking fails with an unsolved constraint, all the skolems are in scope. That wasn't the case before, which led to some obscure error messages; and occasional failures with "no skolem info" (eg #16245). Both of these, and the main Quick Look patch itself, affect a /lot/ of error messages, as you can see from the number of files changed. I've checked them all; I think they are as good or better than before. Smaller things * I documented the various instances of VarBndr better. See Note [The VarBndr tyep and its uses] in GHC.Types.Var * Renamed GHC.Tc.Solver.simpl_top to simplifyTopWanteds * A bit of refactoring in bindExplicitTKTele, to avoid the footwork with Either. Simpler now. * Move promoteTyVar from GHC.Tc.Solver to GHC.Tc.Utils.TcMType Fixes #16245 (comment 211369), memorialised as typecheck/polykinds/T16245a Also fixes the three bugs in #18640 - - - - - a6ee690e by GHC GitLab CI at 2020-09-09T17:09:53+01:00 Bump haddock submodule Accounts for spurious changes in the output of hypsrc-test. - - - - - 30 changed files: - compiler/GHC/Core/TyCon.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Gen/Default.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Sig.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/TyCl.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Types/Evidence.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/Var.hs - docs/users_guide/9.0.1-notes.rst - docs/users_guide/exts/explicit_forall.rst - docs/users_guide/exts/instances.rst - docs/users_guide/ghci.rst - testsuite/tests/dependent/should_fail/T13780a.stderr - testsuite/tests/dependent/should_fail/T14066e.stderr - testsuite/tests/dependent/should_fail/T15859.hs - testsuite/tests/dependent/should_fail/T15859.stderr - + testsuite/tests/dependent/should_fail/T15859a.hs - + testsuite/tests/dependent/should_fail/T15859a.stderr - testsuite/tests/dependent/should_fail/T16344a.stderr - testsuite/tests/dependent/should_fail/all.T - testsuite/tests/gadt/T12468.stderr - testsuite/tests/gadt/gadt-escape1.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f45b94dd9cf698f117e1bc0dd56f3d343cf7c869...a6ee690e7828d95e174c422ac13df70a1d25e27a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f45b94dd9cf698f117e1bc0dd56f3d343cf7c869...a6ee690e7828d95e174c422ac13df70a1d25e27a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 16:21:39 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 09 Sep 2020 12:21:39 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: DynFlags: add OptCoercionOpts Message-ID: <5f590113ab396_80b3f8486336194112491cb@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 2682758b by Ben Gamari at 2020-09-09T12:21:30-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 9bde981c by Ben Gamari at 2020-09-09T12:21:30-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - ce15a1ef by Ben Gamari at 2020-09-09T12:21:30-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 06951c88 by David Himmelstrup at 2020-09-09T12:21:33-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/SimpleOpt.hs - + compiler/GHC/Core/SimpleOpt.hs-boot - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold.hs-boot - + compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - + compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Driver/Types.hs - compiler/GHC/Hs/Expr.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7fe3adc5e0ce745e9882d5915f95dad9f6a626b...06951c88af444da868309ab3056781296a5bb0fc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f7fe3adc5e0ce745e9882d5915f95dad9f6a626b...06951c88af444da868309ab3056781296a5bb0fc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 16:24:31 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 09 Sep 2020 12:24:31 -0400 Subject: [Git][ghc/ghc][wip/T18565] 39 commits: Fix FastString lexicographic ordering (fix #18562) Message-ID: <5f5901bf77fc_80bae1620c11253948@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18565 at Glasgow Haskell Compiler / GHC Commits: 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - f45c0591 by Sebastian Graf at 2020-09-09T17:20:40+02:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - cf1aa1ae by Sebastian Graf at 2020-09-09T18:24:23+02:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Rules.hs - compiler/GHC/Core/TyCo/Rep.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/453092e32fea5057eae9354b2444a49fa28a783f...cf1aa1ae8ca9082b4a3d5682483eed2c6856796a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/453092e32fea5057eae9354b2444a49fa28a783f...cf1aa1ae8ca9082b4a3d5682483eed2c6856796a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 16:33:07 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Wed, 09 Sep 2020 12:33:07 -0400 Subject: [Git][ghc/ghc][wip/T18341] 41 commits: Fix FastString lexicographic ordering (fix #18562) Message-ID: <5f5903c36c5ae_80b592e104112638c8@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18341 at Glasgow Haskell Compiler / GHC Commits: 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - f45c0591 by Sebastian Graf at 2020-09-09T17:20:40+02:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - cf1aa1ae by Sebastian Graf at 2020-09-09T18:24:23+02:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 6eafc6d7 by Sebastian Graf at 2020-09-09T18:27:48+02:00 .gitignore *.hiedb files - - - - - 592d57ee by Sebastian Graf at 2020-09-09T18:32:51+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Rules.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/065216d42291477b3368ba0ec98077cbae7e4cce...592d57ee50ef5bd3a78d1179e79c0f2b4d576a26 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/065216d42291477b3368ba0ec98077cbae7e4cce...592d57ee50ef5bd3a78d1179e79c0f2b4d576a26 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 17:30:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 13:30:52 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump Win32 submodule to 2.9.0.0 Message-ID: <5f59114c76af6_80b3f8458fefddc1127160@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 844f8dba by Ben Gamari at 2020-09-09T13:07:20-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 7 changed files: - compiler/ghc.cabal.in - ghc/ghc-bin.cabal.in - libraries/Cabal - libraries/directory - utils/check-api-annotations/check-api-annotations.cabal - utils/check-ppr/check-ppr.cabal - utils/ghc-cabal/ghc-cabal.cabal Changes: ===================================== compiler/ghc.cabal.in ===================================== @@ -77,7 +77,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else if flag(terminfo) Build-Depends: terminfo == 0.4.* ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -45,7 +45,7 @@ Executable ghc ghc == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else Build-Depends: unix >= 2.7 && < 2.9 @@ -102,4 +102,4 @@ Executable ghc Default-Extensions: NoImplicitPrelude , ScopedTypeVariables - , BangPatterns \ No newline at end of file + , BangPatterns ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 32dad5c1cf70d65ecb93b0ec214445cf9c9f6615 +Subproject commit 2d8a1b60ae409291585b647be8f02bc42b23cbbb ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3d9ca6edc0703860829ab3210db78bb4c4ff72b9 +Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e ===================================== utils/check-api-annotations/check-api-annotations.cabal ===================================== @@ -24,6 +24,6 @@ Executable check-api-annotations Build-Depends: base >= 4 && < 5, containers, - Cabal >= 3.0 && < 3.4, + Cabal >= 3.0 && < 3.6, directory, ghc ===================================== utils/check-ppr/check-ppr.cabal ===================================== @@ -25,7 +25,7 @@ Executable check-ppr Build-Depends: base >= 4 && < 5, bytestring, containers, - Cabal >= 3.0 && < 3.4, + Cabal >= 3.0 && < 3.6, directory, filepath, ghc ===================================== utils/ghc-cabal/ghc-cabal.cabal ===================================== @@ -21,6 +21,6 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 3.0 && < 3.4, + Cabal >= 3.0 && < 3.6, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/844f8dbafa16b5049da79ec783c66917ef62b9ce -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/844f8dbafa16b5049da79ec783c66917ef62b9ce You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 17:53:43 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 13:53:43 -0400 Subject: [Git][ghc/ghc][wip/bump-version] 1550 commits: testsuite: don't collect compiler stats in collect_runtime_residency Message-ID: <5f5916a7dfdb_80b3f8428d2fcd01127435@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-version at Glasgow Haskell Compiler / GHC Commits: 643d42fc by Alp Mestanogullari at 2019-11-12T18:40:19-05:00 testsuite: don't collect compiler stats in collect_runtime_residency We instead want to collect the runtime stats (with collect_stats, instead of collect_compiler_stats). This should fix a number of perf tests failures we have been seeing, where we suddenly started measuring metrics we didn't intend to measure, which tend to fall outside of the acceptance window. Metric Decrease: lazy-bs-alloc T3586 Metric Increase: space_leak_001 T4801 T5835 T12791 - - - - - 535d0edc by Ömer Sinan Ağacan at 2019-11-13T07:06:12-05:00 Document CmmTopInfo type [ci skip] - - - - - 2d4f9ad8 by Ben Gamari at 2019-11-13T07:06:49-05:00 Ensure that coreView/tcView are able to inline Previously an import cycle between Type and TyCoRep meant that several functions in TyCoRep ended up SOURCE import coreView. This is quite unfortunate as coreView is intended to be fused into a larger pattern match and not incur an extra call. Fix this with a bit of restructuring: * Move the functions in `TyCoRep` which depend upon things in `Type` into `Type` * Fold contents of `Kind` into `Type` and turn `Kind` into a simple wrapper re-exporting kind-ish things from `Type` * Clean up the redundant imports that popped up as a result Closes #17441. Metric Decrease: T4334 - - - - - b795637f by Alp Mestanogullari at 2019-11-13T07:07:28-05:00 hadrian: fix Windows CI script By only using 'export' from within bash commands. - - - - - 6885e22c by Ben Gamari at 2019-11-13T07:08:03-05:00 testsuite: Add test for #17458 As noted in #17458, QuantifiedConstraints and UndecideableInstances could previously be used to write programs which can loop at runtime. This was fixed in !1870. - - - - - b4b19d89 by Ben Gamari at 2019-11-13T07:08:03-05:00 users guide: Fix broken link - - - - - 9a939a6c by Ryan Scott at 2019-11-13T07:08:40-05:00 Print name prefixly in the Outputable instance for StandaloneKindSig Issue #17461 was occurring because the `Outputable` instance for standalone kind signatures was simply calling `ppr` on the name in the kind signature, which does not add parentheses to infix names. The solution is simple: use `pprPrefixOcc` instead. Fixes #17461. - - - - - a06cfb59 by Ömer Sinan Ağacan at 2019-11-13T07:09:18-05:00 Only pass mod_location with HscRecomp instead of the entire ModSummary HscRecomp users only need the ModLocation of the module being compiled, so only pass that to users instead of the entire ModSummary Metric Decrease: T4801 - - - - - dd49b3f0 by Ben Gamari at 2019-11-13T17:01:21-05:00 Bump Haskeline and add exceptions as boot library Haskeline now depends upon exceptions. See #16752. - - - - - b06b1858 by Ben Gamari at 2019-11-14T11:30:20-05:00 base: Bump version to 4.14.0.0 Metric Increase: T4801 - - - - - 6ab80439 by Ben Gamari at 2019-11-14T23:05:30-05:00 gitlab-ci: Allow Windows to fail again - - - - - 46afc380 by Ben Gamari at 2019-11-15T09:45:36-05:00 gitlab-ci: Install process to global pkgdb before starting build This is an attempt to mitigate #17480 by ensuring that a functional version of the process library is available before attempting the build. - - - - - 8c5cb806 by Ben Gamari at 2019-11-15T10:45:55-05:00 Bump supported LLVM version to 9.0 - - - - - 8e5851f0 by Ben Gamari at 2019-11-15T10:45:55-05:00 llvm-targets: Update with Clang 9 - - - - - f3ffec27 by Ben Gamari at 2019-11-15T11:54:26-05:00 testsuite: Increase acceptance window of T4801 This statistic is rather unstable. Hopefully fixes #17475. - - - - - c2991f16 by Ben Gamari at 2019-11-15T11:56:10-05:00 users-guide: Drop 8.6.1 release notes - - - - - e8da1354 by Ben Gamari at 2019-11-17T06:48:16-05:00 gitlab-ci: Fix submodule linter We ran it against the .git directory despite the fact that the linter wants to be run against the repository. - - - - - 13290f91 by Ben Gamari at 2019-11-17T06:48:16-05:00 Bump version to 8.10.0 Bumps haddock submodule. - - - - - fa98f823 by Ben Gamari at 2019-11-17T06:48:16-05:00 testsuite: Don't collect residency for T4801 I previously increased the size of the acceptance window from 2% to 5% but this still isn't enough. Regardless, measuring bytes allocated should be sufficient to catch any regressions. - - - - - 002b2842 by Ivan Kasatenko at 2019-11-17T06:49:22-05:00 Make test 16916 more stable across runs - - - - - ca89dd3b by Ben Gamari at 2019-11-17T06:58:17-05:00 users-guide: Address #17329 Adopts the language suggested by @JakobBruenker. - - - - - 2f5ed225 by Ben Gamari at 2019-11-17T07:16:32-05:00 exceptions: Bump submodule back to master The previous commit hasn't made it to master yet. - - - - - 34515e7c by nineonine at 2019-11-17T13:33:22-08:00 Fix random typos [skip ci] - - - - - 4a37a29b by Mario Blažević at 2019-11-17T17:26:24-05:00 Fixed issue #17435, missing Data instances - - - - - 97f1bcae by Andreas Klebinger at 2019-11-17T17:26:24-05:00 Turn some comments into GHC.Hs.Utils into haddocks - - - - - cf7f8e5b by Ben Gamari at 2019-11-17T17:26:26-05:00 testsuite: Skip T17414 on Linux It is typical for $TMP to be a small tmpfson Linux. This test will fail in such cases since we must create a file larger than the filesystem. See #17459. - - - - - 88013b78 by nineonine at 2019-11-19T11:53:16-05:00 Optimize MonadUnique instances based on IO (#16843) Metric Decrease: T14683 - - - - - a8adb5b4 by Ben Gamari at 2019-11-19T11:53:55-05:00 desugar: Drop stale Note [Matching seqId] The need for this note vanished in eae703aa60f41fd232be5478e196b661839ec3de. - - - - - 08d595c0 by Ben Gamari at 2019-11-19T11:53:55-05:00 Give seq a more precise type and remove magic `GHC.Prim.seq` previously had the rather plain type: seq :: forall a b. a -> b -> b However, it also had a special typing rule to applications where `b` is not of kind `Type`. Issue #17440 noted that levity polymorphism allows us to rather give it the more precise type: seq :: forall (r :: RuntimeRep) a (b :: TYPE r). a -> b -> b This allows us to remove the special typing rule that we previously required to allow applications on unlifted arguments. T9404 contains a non-Type application of `seq` which should verify that this works as expected. Closes #17440. - - - - - ec8a463d by Viktor Dukhovni at 2019-11-19T11:54:45-05:00 Enable USE_PTHREAD_FOR_ITIMER also on FreeBSD If using a pthread instead of a timer signal is more reliable, and has no known drawbacks, then FreeBSD is also capable of supporting this mode of operation (tested on FreeBSD 12 with GHC 8.8.1, but no reason why it would not also work on FreeBSD 11 or GHC 8.6). Proposed by Kevin Zhang in: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=241849 - - - - - cd40e12a by Ömer Sinan Ağacan at 2019-11-19T11:55:36-05:00 Packages.hs: use O(n*log(n)) ordNub instead of O(n*n) nub As reported in #8173 in some environments package lists can get quite long, so we use more efficient ordNub instead of nub on package lists. - - - - - 2b27cc16 by Ben Gamari at 2019-11-19T11:56:21-05:00 Properly account for libdw paths in make build system Should finally fix #17255. - - - - - 0418c38d by Ben Gamari at 2019-11-19T11:56:58-05:00 rts: Add missing include of SymbolExtras.h This broke the Windows build. - - - - - c819c0e4 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Use correct info table pointer accessor Previously we used INFO_PTR_TO_STRUCT instead of THUNK_INFO_PTR_TO_STRUCT when looking at a thunk. These two happen to be equivalent on 64-bit architectures due to alignment considerations however they are different on 32-bit platforms. This lead to #17487. To fix this we also employ a small optimization: there is only one thunk of type WHITEHOLE (namely stg_WHITEHOLE_info). Consequently, we can just use a plain pointer comparison instead of testing against info->type. - - - - - deed8e31 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Fix incorrect masking in mark queue type test We were using TAG_BITS instead of TAG_MASK. This happened to work on 64-bit platforms where TAG_BITS==3 since we only use tag values 0 and 3. However, this broken on 32-bit platforms where TAG_BITS==2. - - - - - 097f8072 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Rework mark queue representation The previous representation needlessly limited the array length to 16-bits on 32-bit platforms. - - - - - eb7b233a by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Fix handling on large object marking on 32-bit Previously we would reset the pointer pointing to the object to be marked to the beginning of the block when marking a large object. This did no harm on 64-bit but on 32-bit it broke, e.g. `arr020`, since we align pinned ByteArray allocations such that the payload is 8 byte-aligned. This means that the object might not begin at the beginning of the block., - - - - - a7571a74 by Ben Gamari at 2019-11-19T11:57:36-05:00 testsuite: Increase width of stack003 test Previously the returned tuple seemed to fit in registers on amd64. This meant that non-moving collector bug would cause the test to fail on i386 yet not amd64. - - - - - 098d5017 by Ben Gamari at 2019-11-19T11:57:36-05:00 nonmoving: Drop redundant write barrier on stack underflow Previously we would push stack-carried return values to the new stack on a stack overflow. While the precise reasoning for this barrier is unfortunately lost to history, in hindsight I suspect it was prompted by a missing barrier elsewhere (that has been since fixed). Moreover, there the redundant barrier is actively harmful: the stack may contain non-pointer values; blindly pushing these to the mark queue will result in a crash. This is precisely what happened in the `stack003` test. However, because of a (now fixed) deficiency in the test this crash did not trigger on amd64. - - - - - e57b7cc6 by Roland Zumkeller at 2019-11-19T20:39:19-05:00 Changing Thread IDs from 32 bits to 64 bits. - - - - - d1f3c637 by Roland Zumkeller at 2019-11-19T20:39:19-05:00 Use pointer equality in Eq/Ord for ThreadId Changes (==) to use only pointer equality. This is safe because two threads are the same iff they have the same id. Changes `compare` to check pointer equality first and fall back on ids only in case of inequality. See discussion in #16761. - - - - - ef8a08e0 by Alexey Kuleshevich at 2019-11-19T20:39:20-05:00 hpc: Fix encoding issues. Add test for and fix #17073 * Make sure files are being read/written in UTF-8. Set encoding while writing HTML output. Also set encoding while writing and reading .tix files although we don't yet have a ticket complaining that this poses problems. * Set encoding in html header to utf8 * Upgrade to new version of 'hpc' library and reuse `readFileUtf8` and `writeFileUtf8` functions * Update git submodule for `hpc` * Bump up `hpc` executable version Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - b79e46d6 by Vladislav Zavialov at 2019-11-19T20:39:20-05:00 Strip parentheses in expressions contexts in error messages This makes error messages a tad less noisy. - - - - - 13bbde77 by Ben Gamari at 2019-11-21T13:56:56-05:00 Bump hsc2hs submodule Including Phyx's backport of the process changes fixing #17480. - - - - - d4d10501 by Ben Gamari at 2019-11-23T09:42:38-05:00 Bump hsc2hs submodule again This fixes the Darwin build. - - - - - 889d475b by nineonine at 2019-11-23T18:53:29-05:00 Fix typo in Note reference [skip ci] - - - - - 8a33abfc by Ryan Scott at 2019-11-23T18:54:05-05:00 Target the IsList instance for ZipList at base-4.14.0.0 (#17489) This moves the changelog entry about the instance from `base-4.15.0.0` to `base-4.14.0.0`. This accomplishes part (1) from #17489. [ci skip] - - - - - e43e6ece by Ben Gamari at 2019-11-23T18:54:41-05:00 rts: Expose interface for configuring EventLogWriters This exposes a set of interfaces from the GHC API for configuring EventLogWriters. These can be used by consumers like [ghc-eventlog-socket](https://github.com/bgamari/ghc-eventlog-socket). - - - - - de6bbdf2 by Matheus Magalhães de Alcantara at 2019-11-23T18:55:23-05:00 Take care to not eta-reduce jumps in CorePrep CorePrep already had a check to prevent it from eta-reducing Ids that respond true to hasNoBinding (foreign calls, constructors for unboxed sums and products, and Ids with compulsory unfoldings). It did not, however, consider join points as ids that 'must be saturated'. Checking whether the Id responds True to 'isJoinId' should prevent CorePrep from turning saturated jumps like the following (from #17429) into undersaturated ones: (\ eta_XP -> join { mapped_s1vo _ = lvl_s1vs } in jump mapped_s1vo eta_XP) - - - - - 4a1e7e47 by Matheus Magalhães de Alcantara at 2019-11-23T18:55:23-05:00 Make CorePrep.tryEtaReducePrep and CoreUtils.tryEtaReduce line up Simon PJ says he prefers this fix to #17429 over banning eta-reduction for jumps entirely. Sure enough, this also works. Test case: simplCore/should_compile/T17429.hs - - - - - 15f1dc33 by Ryan Scott at 2019-11-23T18:56:00-05:00 Prevent -optc arguments from being duplicated in reverse order (#17471) This reverts a part of commit 7bc5d6c6578ab9d60a83b81c7cc14819afef32ba that causes all arguments to `-optc` (and `-optcxx`) to be passed twice to the C/C++ compiler, once in reverse order and then again in the correct order. While passing duplicate arguments is usually harmless it can cause breakage in this pattern, which is employed by Hackage libraries in the wild: ``` ghc Foo.hs foo.c -optc-D -optcFOO ``` As `FOO -D -D FOO` will cause compilers to error. Fixes #17471. - - - - - e85c9b22 by Ben Gamari at 2019-11-23T18:56:36-05:00 Bump ghc version to 8.11 - - - - - 0e6c2045 by Ben Gamari at 2019-11-23T18:57:12-05:00 rts: Consolidate spinlock implementation Previously we had two distinct implementations: one with spinlock profiling and another without. This seems like needless duplication. - - - - - cb11fcb5 by Ben Gamari at 2019-11-23T18:57:49-05:00 Packages: Don't use expectJust Throw a slightly more informative error on failure. Motivated by the errors seen in !2160. - - - - - 5747ebe9 by Sebastian Graf at 2019-11-23T18:58:25-05:00 Stricten functions ins GHC.Natural This brings `Natural` on par with `Integer` and fixes #17499. Also does some manual CSE for 0 and 1 literals. - - - - - c14b723f by Ömer Sinan Ağacan at 2019-11-23T18:59:06-05:00 Bump exceptions submodule Adds a few files generated by GHC's configure script to .gitignore - - - - - 7b4c7b75 by Brian Wignall at 2019-11-23T19:04:52-05:00 Fix typos - - - - - 6008206a by Viktor Dukhovni at 2019-11-24T14:33:18-05:00 On FreeBSD 12 sys/sysctl.h requires sys/types.h Else build fails with: In file included from ExecutablePath.hsc:42: /usr/include/sys/sysctl.h:1062:25: error: unknown type name 'u_int'; did you mean 'int'? int sysctl(const int *, u_int, void *, size_t *, const void *, size_t); ^~~~~ int compiling libraries/base/dist-install/build/System/Environment/ExecutablePath_hsc_make.c failed (exit code 1) Perhaps also also other FreeBSD releases, but additional include will no harm even if not needed. - - - - - b694b566 by Ben Gamari at 2019-11-24T14:33:54-05:00 configure: Fix HAVE_C11_ATOMICS macro Previously we were using AC_DEFINE instead of AC_DEFINE_UNQUOTED, resulted in the variable not being interpolated. Fixes #17505. - - - - - 8b8dc366 by Krzysztof Gogolewski at 2019-11-25T14:37:38+01:00 Remove prefix arrow support for GADTs (#17211) This reverts the change in #9096. The specialcasing done for prefix (->) is brittle and does not support VTA, type families, type synonyms etc. - - - - - 5a08f7d4 by Sebastian Graf at 2019-11-27T00:14:59-05:00 Make warnings for TH splices opt-in In #17270 we have the pattern-match checker emit incorrect warnings. The reason for that behavior is ultimately an inconsistency in whether we treat TH splices as written by the user (`FromSource :: Origin`) or as generated code (`Generated`). This was first reported in #14838. The current solution is to TH splices as `Generated` by default and only treat them as `FromSource` when the user requests so (-fenable-th-splice-warnings). There are multiple reasons for opt-in rather than opt-out: * It's not clear that the user that compiles a splice is the author of the code that produces the warning. Think of the situation where she just splices in code from a third-party library that produces incomplete pattern matches. In this scenario, the user isn't even able to fix that warning. * Gathering information for producing the warnings (pattern-match check warnings in particular) is costly. There's no point in doing so if the user is not interested in those warnings. Fixes #17270, but not #14838, because the proper solution needs a GHC proposal extending the TH AST syntax. - - - - - 8168b42a by Vladislav Zavialov at 2019-11-27T11:32:18+03:00 Whitespace-sensitive bang patterns (#1087, #17162) This patch implements a part of GHC Proposal #229 that covers five operators: * the bang operator (!) * the tilde operator (~) * the at operator (@) * the dollar operator ($) * the double dollar operator ($$) Based on surrounding whitespace, these operators are disambiguated into bang patterns, lazy patterns, strictness annotations, type applications, splices, and typed splices. This patch doesn't cover the (-) operator or the -Woperator-whitespace warning, which are left as future work. - - - - - 9e5477c4 by Ryan Scott at 2019-11-27T20:01:50-05:00 Fix @since annotations for isResourceVanishedError and friends (#17488) - - - - - e122ba33 by Sergei Trofimovich at 2019-11-27T20:02:29-05:00 .gitmodules: tweak 'exception' URL to avoid redirection warnings Avoid initial close warning of form: ``` Cloning into 'exceptions'... warning: redirecting to https://gitlab.haskell.org/ghc/packages/exceptions.git/ ``` Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 5f84b52a by Philipp Krüger at 2019-11-28T02:54:05-05:00 Reduce boolean blindness in OccInfo(OneOcc) #17482 * Transformed the type aliases `InterestingCxt`, `InsideLam` and `OneBranch` into data types. * Added Semigroup and Monoid instances for use in orOccInfo in OccurAnal.hs * Simplified some usage sites by using pattern matching instead of boolean algebra. Metric Increase: T12150 This increase was on a Mac-build of exactly 1%. This commit does *not* re-intruduce the asymptotic memory usage described in T12150. - - - - - 3748ba3a by Brian Wignall at 2019-11-28T02:54:52-05:00 Fix typos, using Wikipedia list of common typos - - - - - 6c59cc71 by Stefan Schulze Frielinghaus at 2019-11-28T02:55:33-05:00 Fix endian handling of LLVM backend Get rid of CPP macro WORDS_BIGENDIAN which is not defined anymore, and replace it by DynFlag. This fixes partially #17337. - - - - - 6985e0fc by Vladislav Zavialov at 2019-11-28T15:47:53+03:00 Factor out HsSCC/HsCoreAnn/HsTickPragma into HsPragE This is a refactoring with no user-visible changes (except for GHC API users). Consider the HsExpr constructors that correspond to user-written pragmas: HsSCC representing {-# SCC ... #-} HsCoreAnn representing {-# CORE ... #-} HsTickPragma representing {-# GENERATED ... #-} We can factor them out into a separate datatype, HsPragE. It makes the code a bit tidier, especially in the parser. Before this patch: hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,Int))), ((SourceText,SourceText),(SourceText,SourceText)) ) } After this patch: prag_hpc :: { Located ([AddAnn], HsPragE GhcPs) } - - - - - 7f695a20 by Ömer Sinan Ağacan at 2019-11-29T08:25:28-05:00 Pass ModDetails with (partial) ModIface in HscStatus (Partial) ModIface and ModDetails are generated at the same time, but they're passed differently: ModIface is passed in HscStatus consturctors while ModDetails is returned in a tuple. This refactors ModDetails passing so that it's passed around with ModIface in HscStatus constructors. This makes the code more consistent and hopefully easier to understand: ModIface and ModDetails are really very closely related. It makes sense to treat them the same way. - - - - - e921c90f by Ömer Sinan Ağacan at 2019-11-29T08:26:07-05:00 Improve few Foreign.Marshal.Utils docs In copyBytes and moveBytes mention which argument is source and which is destination. Also fixes some of the crazy indentation in the module and cleans trailing whitespace. - - - - - 316f2431 by Sebastian Graf at 2019-11-30T02:57:58-05:00 Hadrian docs: Rename the second "validate" entry to "slow-validate" [ci skip] That would be in line with the implementation. - - - - - 5aba5d32 by Vladislav Zavialov at 2019-11-30T02:58:34-05:00 Remove HasSrcSpan (#17494) Metric Decrease: haddock.compiler - - - - - d1de5c22 by Sylvain Henry at 2019-11-30T02:59:13-05:00 Use Hadrian by default in validate script (#17527) - - - - - 3a96a0b6 by Sebastian Graf at 2019-11-30T02:59:55-05:00 Simpler Semigroup instance for InsideLam and InterestingCtxt This mirrors the definition of `(&&)` and `(||)` now, relieving the Simplifier of a marginal amount of pressure. - - - - - f8cfe81a by Roland Senn at 2019-11-30T20:33:49+01:00 Improve tests for #17171 While backporting MR !1806 to 8.8.2 (!1885) I learnt the following: * Tests with `expect_fail` do not compare `*.stderr` output files. So a test using `expect_fail` will not detect future regressions on the `stderr` output. * To compare the `*.stderr` output files, I have to use the `exit_code(n)` function. * When a release is made, tests with `makefile_test` are converted to use `run_command`. * For the test `T17171a` the return code is `1` when running `makefile_test`, however it's `2` when running `run_command`. Therefore I decided: * To improve my tests for #17171 * To change test T17171a from `expect_fail` to `exit_code(2)` * To change both tests from `makefile_test` to `run_command` - - - - - 2b113fc9 by Vladislav Zavialov at 2019-12-01T08:17:05-05:00 Update DisambECP-related comments - - - - - beed7c3e by Ben Gamari at 2019-12-02T03:41:37-05:00 testsuite: Fix location of typing_stubs module This should fix the build on Debian 8. - - - - - 53251413 by Ben Gamari at 2019-12-02T03:42:14-05:00 testsuite: Don't override LD_LIBRARY_PATH, only prepend NixOS development environments often require that LD_LIBRARY_PATH be set in order to find system libraries. T1407 was overriding LD_LIBRARY_PATH, dropping these directories. Now it merely prepends, its directory. - - - - - 65400314 by Krzysztof Gogolewski at 2019-12-02T03:42:57-05:00 Convert warnings into assertions Since the invariants always hold in the testsuite, we can convert them to asserts. - - - - - 18baed64 by Alan Zimmerman at 2019-12-02T03:43:37-05:00 API Annotations: Unicode '->' on HsForallTy The code fragment type family Proxy2' ∷ ∀ k → k → Type where Proxy2' = Proxy' Generates AnnRarrow instead of AnnRarrowU for the first →. Fixes #17519 - - - - - 717f3236 by Brian Wignall at 2019-12-02T03:44:16-05:00 Fix more typos - - - - - bde48f8e by Ben Gamari at 2019-12-02T11:55:34-05:00 More Haddock syntax in GHC.Hs.Utils As suggested by RyanGlScott in !2163. - - - - - 038bedbc by Ben Gamari at 2019-12-02T11:56:18-05:00 Simplify: Fix pretty-printing of strictness A colleague recently hit the panic in Simplify.addEvals and I noticed that the message is quite unreadable due to incorrect pretty-printing. Fix this. - - - - - c500f652 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Fix changelog linting logic - - - - - 8ead967d by Ben Gamari at 2019-12-02T11:56:54-05:00 win32-init: Drop workaround for #17480 The `process` changes have now been merged into `hsc2hs`. (cherry picked from commit fa029f53132ad59f847ed012d3b835452cf16615) - - - - - d402209a by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Disable Sphinx build on Debian 8 The docutils version available appears to be too old to support the `table` directive's `:widths:` options. (cherry picked from commit 75764487a96a7a026948b5af5022781872d12baa) - - - - - f1f68824 by Ben Gamari at 2019-12-02T11:56:54-05:00 base: Fix <unistd.h> #include Previously we were including <sys/unistd.h> which is available on glibc but not musl. (cherry picked from commit e44b695ca7cb5f3f99eecfba05c9672c6a22205e) - - - - - 37eb94b3 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Bump Docker images Installs pxz on Centos7 (cherry picked from commit 86960e691f7a600be247c32a7cf795bf9abf7cc4) - - - - - aec98a79 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: pxz is unavailable on CentOS 7 Fall back to xz - - - - - 6708b8e5 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Set LANG on CentOS 7 It otherwise seems to default to ascii - - - - - 470ef0e7 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Consolidate release build configuration - - - - - 38338757 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Add Debian 10 builds - - - - - 012f13b5 by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Fix Windows bindist collection Apparently variable interpolation in the `artifacts.paths` key of `gitlab-ci.yml` doesn't work on Windows as it does on WIndows. (cherry picked from commit 100cc756faa4468ed6950116bae30609c1c3468b) - - - - - a0f09e23 by Ben Gamari at 2019-12-02T11:56:54-05:00 testsuite: Simplify Python <3.5 fallback for TextIO (cherry picked from commit d092d8598694c23bc07cdcc504dff52fa5f33be1) - - - - - 2b2370ec by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Add release-x86_64-linux-deb9 job (cherry picked from commit cbedb3c4a90649f474cb716842ba53afc5a642ca) - - - - - b1c206fd by Ben Gamari at 2019-12-02T11:56:54-05:00 gitlab-ci: Always build source tarball (cherry picked from commit 67b5de88ef923971f1980335137e3c7193213abd) - - - - - 4cbd5b47 by Sergei Trofimovich at 2019-12-02T11:57:33-05:00 configure.ac: make cross-compiler detection stricter Be more precise at detecting cross-compilation case. Before the change configuration $ ./configure --host=x86_64-pc-linux-gnu --target=x86_64-gentoo-linux-musl was not considered a cross-target. Even though libcs are different (`glibc` vs. `musl`). Without this patch build fails as: ``` "inplace/bin/ghc-cabal" check libraries/integer-gmp "inplace/bin/ghc-cabal" configure libraries/integer-gmp dist-install \ --with-ghc="/home/slyfox/dev/git/ghc/inplace/bin/ghc-stage1" \ --with-ghc-pkg="/home/slyfox/dev/git/ghc/inplace/bin/ghc-pkg" \ --disable-library-for-ghci --enable-library-vanilla --enable-library-for-ghci \ --enable-library-profiling --enable-shared --with-hscolour="/usr/bin/HsColour" \ --configure-option=CFLAGS="-Wall \ -Werror=unused-but-set-variable -Wno-error=inline \ -iquote /home/slyfox/dev/git/ghc/libraries/integer-gmp" \ --configure-option=LDFLAGS=" " --configure-option=CPPFLAGS=" \ " --gcc-options="-Wall -Werror=unused-but-set-variable -Wno-error=inline -iquote /home/slyfox/dev/git/ghc/libraries/integer-gmp \ " --with-gcc="x86_64-gentoo-linux-musl-gcc" --with-ld="x86_64-gentoo-linux-musl-ld.gold" --with-ar="x86_64-gentoo-linux-musl-ar" \ --with-alex="/usr/bin/alex" --with-happy="/usr/bin/happy" Configuring integer-gmp-1.0.2.0... configure: WARNING: unrecognized options: --with-compiler checking build system type... x86_64-pc-linux-gnu checking host system type... x86_64-pc-linux-gnu checking target system type... x86_64-pc-linux-gnu checking for gcc... /usr/lib/ccache/bin/x86_64-gentoo-linux-musl-gcc checking whether the C compiler works... yes checking for C compiler default output file name... a.out checking for suffix of executables... checking whether we are cross compiling... configure: error: in `/home/slyfox/dev/git/ghc/libraries/integer-gmp/dist-install/build': configure: error: cannot run C compiled programs. If you meant to cross compile, use `--host'. See `config.log' for more details make[1]: *** [libraries/integer-gmp/ghc.mk:5: libraries/integer-gmp/dist-install/package-data.mk] Error 1 make: *** [Makefile:126: all] Error 2 ``` Note: here `ghc-stage1` is assumed to target `musl` target but is passed `glibc` toolchain. It happens because initial ./configure phase did not detect host/target as different. Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - 5f7cb423 by Sylvain Henry at 2019-12-02T23:59:29-05:00 Add `timesInt2#` primop - - - - - fbbe18a2 by Sylvain Henry at 2019-12-02T23:59:29-05:00 Use the new timesInt2# primop in integer-gmp (#9431) - - - - - 5a4b8d0c by Athas at 2019-12-03T00:00:09-05:00 Document RTS behaviour upon encountering '--'. - - - - - 705a16df by Ben Gamari at 2019-12-03T07:11:33-05:00 Make BCO# lifted In #17424 Simon PJ noted that there is a potentially unsafe occurrence of unsafeCoerce#, coercing from an unlifted to lifted type. However, nowhere in the compiler do we assume that a BCO# is not a thunk. Moreover, in the case of a CAF the result returned by `createBCO` *will* be a thunk (as noted in [Updatable CAF BCOs]). Consequently it seems better to rather make BCO# a lifted type and rename it to BCO. - - - - - 35afe4f3 by Sylvain Henry at 2019-12-03T07:12:13-05:00 Use Int# primops in `Bits Int{8,16,32,64}` instances - - - - - 7a51b587 by Sylvain Henry at 2019-12-03T07:12:13-05:00 Add constant folding rule (#16402) narrowN (x .&. m) m .&. (2^N-1) = 2^N-1 ==> narrowN x e.g. narrow16 (x .&. 0x12FFFF) ==> narrow16 x - - - - - 10caee7f by Ben Gamari at 2019-12-03T21:04:50-05:00 users-guide: Add 8.12.1 release notes - - - - - 25019d18 by Ben Gamari at 2019-12-03T21:04:50-05:00 Drop Uniquable constraint for AnnTarget This relied on deriveUnique, which was far too subtle to be safely applied. Thankfully the instance doesn't appear to be used so let's just drop it. - - - - - 78b67ad0 by Ben Gamari at 2019-12-03T21:04:50-05:00 Simplify uniqAway This does two things: * Eliminate all uses of Unique.deriveUnique, which was quite easy to mis-use and extremely subtle. * Rename the previous "derived unique" notion to "local unique". This is possible because the only places where `uniqAway` can be safely used are those where local uniqueness (with respect to some InScopeSet) is sufficient. * Rework the implementation of VarEnv.uniqAway, as discussed in #17462. This should make the operation significantly more efficient than its previous iterative implementation.. Metric Decrease: T9872c T12227 T9233 T14683 T5030 T12545 hie002 Metric Increase: T9961 - - - - - f03a41d4 by Ben Gamari at 2019-12-03T21:05:27-05:00 Elf: Fix link info note generation Previously we would use the `.int` assembler directive to generate 32-bit words in the note section. However, `.int` is note guaranteed to produce 4-bytes; in fact, on some platforms (e.g. AArch64) it produces 8-bytes. Use the `.4bytes` directive to avoid this. Moreover, we used the `.align` directive, which is quite platform dependent. On AArch64 it appears to not even be idempotent (despite what the documentation claims). `.balign` is consequentially preferred as it offers consistent behavior across platforms. - - - - - 84585e5e by Vladislav Zavialov at 2019-12-05T16:07:44-05:00 Meaning-preserving SCC annotations (#15730) This patch implements GHC Proposal #176: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0176-scc-parsing.rst Before the change: 1 / 2 / 2 = 0.25 1 / {-# SCC "name" #-} 2 / 2 = 1.0 After the change: 1 / 2 / 2 = 0.25 1 / {-# SCC "name" #-} 2 / 2 = parse error - - - - - e49e5470 by Vladislav Zavialov at 2019-12-05T16:07:44-05:00 Improve error messages for SCC pragmas - - - - - a2b535d9 by Ben Gamari at 2019-12-05T16:07:45-05:00 users guide: Try to silence underfull \hbox warnings We use two tricks, as suggested here [1]: * Use microtype to try to reduce the incidence of underfull boxes * Bump up \hbadness to eliminate the warnings - - - - - 4e47217f by Bodigrim at 2019-12-05T16:07:47-05:00 Make sameNat and sameSymbol proxy-polymorphic - - - - - 8324f0b7 by Bodigrim at 2019-12-05T16:07:47-05:00 Test proxy-polymorphic sameNat and sameSymbol - - - - - 69001f54 by Ben Gamari at 2019-12-05T16:07:48-05:00 nonmoving: Clear segment bitmaps during sweep Previously we would clear the bitmaps of segments which we are going to sweep during the preparatory pause. However, this is unnecessary: the existence of the mark epoch ensures that the sweep will correctly identify non-reachable objects, even if we do not clear the bitmap. We now defer clearing the bitmap to sweep, which happens concurrently with mutation. - - - - - 58a9c429 by Ben Gamari at 2019-12-05T16:07:48-05:00 testsuite: Disable divByZero on non-NCG targets The LLVM backend does not guarantee any particular semantics for division by zero, making this test unreliable across platforms. - - - - - 8280bd8a by Ben Gamari at 2019-12-05T16:07:49-05:00 testsuite: Factor out terminal coloring - - - - - 92a52aaa by Ben Gamari at 2019-12-05T16:07:49-05:00 testsuite: Make performance metric summary more readable Along with some refactoring. - - - - - c4ca29c7 by Ben Gamari at 2019-12-05T16:07:49-05:00 testsuite: Use colors more consistently - - - - - 3354c68e by Vladislav Zavialov at 2019-12-05T16:07:49-05:00 Pretty-printing of the * kind Before this patch, GHC always printed the * kind unparenthesized. This led to two issues: 1. Sometimes GHC printed invalid or incorrect code. For example, GHC would print: type F @* x = x when it meant to print: type F @(*) x = x In the former case, instead of a kind application we were getting a type operator (@*). 2. Sometimes GHC printed kinds that were correct but hard to read. Should Either * Int be read as Either (*) Int or as (*) Either Int ? This depends on whether -XStarIsType is enabled, but it would be easier if we didn't have to check for the flag when reading the code. We can solve both problems by assigning (*) a different precedence. Note that Haskell98 kinds are not affected: ((* -> *) -> *) -> * does NOT become (((*) -> (*)) -> (*)) -> (*) The parentheses are added when (*) is used in a function argument position: F * * * becomes F (*) (*) (*) F A * B becomes F A (*) B Proxy * becomes Proxy (*) a * -> * becomes a (*) -> * - - - - - 70dd0e4b by Vladislav Zavialov at 2019-12-05T16:07:49-05:00 Parenthesize the * kind in TH.Ppr - - - - - a7a4efbf by Ben Gamari at 2019-12-05T16:07:49-05:00 rts/NonMovingSweep: Fix locking of new mutable list allocation Previously we used allocBlockOnNode_sync in nonmovingSweepMutLists despite the fact that we aren't in the GC and therefore the allocation spinlock isn't in use. This meant that sweep would end up spinning until the next minor GC, when the SM lock was moved away from the SM_MUTEX to the spinlock. This isn't a correctness issue but it sure isn't good for performance. Found thanks for Ward. Fixes #17539. - - - - - f171b358 by Matthias Braun at 2019-12-05T16:07:51-05:00 Fix typo in documentation of Base.hs. - - - - - 9897e8c8 by Gabor Greif at 2019-12-06T21:20:38-05:00 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. Here's a simple example of the new code gen: data D = D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 On a 64-bit system previously all constructors would be tagged 1. With the new code gen D7 and D8 are tagged 7: [Lib.D7_con_entry() { ... {offset c1eu: // global R1 = R1 + 7; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; } }] [Lib.D8_con_entry() { ... {offset c1ez: // global R1 = R1 + 7; call (P64[Sp])(R1) args: 8, res: 0, upd: 8; } }] When switching we now look at the info table only when the tag is 7. For example, if we derive Enum for the type above, the Cmm looks like this: c2Le: _s2Js::P64 = R1; _c2Lq::P64 = _s2Js::P64 & 7; switch [1 .. 7] _c2Lq::P64 { case 1 : goto c2Lk; case 2 : goto c2Ll; case 3 : goto c2Lm; case 4 : goto c2Ln; case 5 : goto c2Lo; case 6 : goto c2Lp; case 7 : goto c2Lj; } // Read info table for tag c2Lj: _c2Lv::I64 = %MO_UU_Conv_W32_W64(I32[I64[_s2Js::P64 & (-8)] - 4]); if (_c2Lv::I64 != 6) goto c2Lu; else goto c2Lt; Generated Cmm sizes do not change too much, but binaries are very slightly larger, due to the fact that the new instructions are longer in encoded form. E.g. previously entry code for D8 above would be 00000000000001c0 <Lib_D8_con_info>: 1c0: 48 ff c3 inc %rbx 1c3: ff 65 00 jmpq *0x0(%rbp) With this patch 00000000000001d0 <Lib_D8_con_info>: 1d0: 48 83 c3 07 add $0x7,%rbx 1d4: ff 65 00 jmpq *0x0(%rbp) This is one byte longer. Secondly, reading info table directly and then switching is shorter _c1co: movq -1(%rbx),%rax movl -4(%rax),%eax // Switch on info table tag jmp *_n1d5(,%rax,8) than doing the same switch, and then for the tag 7 doing another switch: // When tag is 7 _c1ct: andq $-8,%rbx movq (%rbx),%rax movl -4(%rax),%eax // Switch on info table tag ... Some changes of binary sizes in actual programs: - In NoFib the worst case is 0.1% increase in benchmark "parser" (see NoFib results below). All programs get slightly larger. - Stage 2 compiler size does not change. - In "containers" (the library) size of all object files increases 0.0005%. Size of the test program "bitqueue-properties" increases 0.03%. nofib benchmarks kindly provided by Ömer (@osa1): NoFib Results ============= -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS +0.0% 0.0% -0.0% -0.0% -0.0% CSD +0.0% 0.0% 0.0% +0.0% +0.0% FS +0.0% 0.0% 0.0% +0.0% 0.0% S +0.0% 0.0% -0.0% 0.0% 0.0% VS +0.0% 0.0% -0.0% +0.0% +0.0% VSD +0.0% 0.0% -0.0% +0.0% -0.0% VSM +0.0% 0.0% 0.0% 0.0% 0.0% anna +0.0% 0.0% +0.1% -0.9% -0.0% ansi +0.0% 0.0% -0.0% +0.0% +0.0% atom +0.0% 0.0% 0.0% 0.0% 0.0% awards +0.0% 0.0% -0.0% +0.0% 0.0% banner +0.0% 0.0% -0.0% +0.0% 0.0% bernouilli +0.0% 0.0% +0.0% +0.0% +0.0% binary-trees +0.0% 0.0% -0.0% -0.0% -0.0% boyer +0.0% 0.0% +0.0% 0.0% -0.0% boyer2 +0.0% 0.0% +0.0% 0.0% -0.0% bspt +0.0% 0.0% +0.0% +0.0% 0.0% cacheprof +0.0% 0.0% +0.1% -0.8% 0.0% calendar +0.0% 0.0% -0.0% +0.0% -0.0% cichelli +0.0% 0.0% +0.0% 0.0% 0.0% circsim +0.0% 0.0% -0.0% -0.1% -0.0% clausify +0.0% 0.0% +0.0% +0.0% 0.0% comp_lab_zift +0.0% 0.0% +0.0% 0.0% -0.0% compress +0.0% 0.0% +0.0% +0.0% 0.0% compress2 +0.0% 0.0% 0.0% 0.0% 0.0% constraints +0.0% 0.0% -0.0% -0.0% -0.0% cryptarithm1 +0.0% 0.0% +0.0% 0.0% 0.0% cryptarithm2 +0.0% 0.0% +0.0% -0.0% 0.0% cse +0.0% 0.0% +0.0% +0.0% 0.0% digits-of-e1 +0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 +0.0% 0.0% +0.0% -0.0% -0.0% dom-lt +0.0% 0.0% +0.0% +0.0% 0.0% eliza +0.0% 0.0% -0.0% +0.0% 0.0% event +0.0% 0.0% -0.0% -0.0% -0.0% exact-reals +0.0% 0.0% +0.0% +0.0% +0.0% exp3_8 +0.0% 0.0% -0.0% -0.0% -0.0% expert +0.0% 0.0% +0.0% +0.0% +0.0% fannkuch-redux +0.0% 0.0% +0.0% 0.0% 0.0% fasta +0.0% 0.0% -0.0% -0.0% -0.0% fem +0.0% 0.0% +0.0% +0.0% +0.0% fft +0.0% 0.0% +0.0% -0.0% -0.0% fft2 +0.0% 0.0% +0.0% +0.0% +0.0% fibheaps +0.0% 0.0% +0.0% +0.0% 0.0% fish +0.0% 0.0% +0.0% +0.0% 0.0% fluid +0.0% 0.0% +0.0% +0.0% +0.0% fulsom +0.0% 0.0% +0.0% -0.0% +0.0% gamteb +0.0% 0.0% +0.0% -0.0% -0.0% gcd +0.0% 0.0% +0.0% +0.0% 0.0% gen_regexps +0.0% 0.0% +0.0% -0.0% -0.0% genfft +0.0% 0.0% -0.0% -0.0% -0.0% gg +0.0% 0.0% 0.0% -0.0% 0.0% grep +0.0% 0.0% +0.0% +0.0% +0.0% hidden +0.0% 0.0% +0.0% -0.0% -0.0% hpg +0.0% 0.0% +0.0% -0.1% -0.0% ida +0.0% 0.0% +0.0% -0.0% -0.0% infer +0.0% 0.0% -0.0% -0.0% -0.0% integer +0.0% 0.0% -0.0% -0.0% -0.0% integrate +0.0% 0.0% 0.0% +0.0% 0.0% k-nucleotide +0.0% 0.0% -0.0% -0.0% -0.0% kahan +0.0% 0.0% -0.0% -0.0% -0.0% knights +0.0% 0.0% +0.0% -0.0% -0.0% lambda +0.0% 0.0% +1.2% -6.1% -0.0% last-piece +0.0% 0.0% +0.0% -0.0% -0.0% lcss +0.0% 0.0% +0.0% -0.0% -0.0% life +0.0% 0.0% +0.0% -0.0% -0.0% lift +0.0% 0.0% +0.0% +0.0% 0.0% linear +0.0% 0.0% +0.0% +0.0% +0.0% listcompr +0.0% 0.0% -0.0% -0.0% -0.0% listcopy +0.0% 0.0% -0.0% -0.0% -0.0% maillist +0.0% 0.0% +0.0% -0.0% -0.0% mandel +0.0% 0.0% +0.0% +0.0% +0.0% mandel2 +0.0% 0.0% +0.0% +0.0% -0.0% mate +0.0% 0.0% +0.0% +0.0% +0.0% minimax +0.0% 0.0% -0.0% +0.0% -0.0% mkhprog +0.0% 0.0% +0.0% +0.0% +0.0% multiplier +0.0% 0.0% 0.0% +0.0% -0.0% n-body +0.0% 0.0% +0.0% -0.0% -0.0% nucleic2 +0.0% 0.0% +0.0% +0.0% -0.0% para +0.0% 0.0% +0.0% +0.0% +0.0% paraffins +0.0% 0.0% +0.0% +0.0% +0.0% parser +0.1% 0.0% +0.4% -1.7% -0.0% parstof +0.0% 0.0% -0.0% -0.0% -0.0% pic +0.0% 0.0% +0.0% 0.0% -0.0% pidigits +0.0% 0.0% -0.0% -0.0% -0.0% power +0.0% 0.0% +0.0% -0.0% -0.0% pretty +0.0% 0.0% +0.0% +0.0% +0.0% primes +0.0% 0.0% +0.0% 0.0% 0.0% primetest +0.0% 0.0% +0.0% +0.0% +0.0% prolog +0.0% 0.0% +0.0% +0.0% +0.0% puzzle +0.0% 0.0% +0.0% +0.0% +0.0% queens +0.0% 0.0% 0.0% +0.0% +0.0% reptile +0.0% 0.0% +0.0% +0.0% 0.0% reverse-complem +0.0% 0.0% -0.0% -0.0% -0.0% rewrite +0.0% 0.0% +0.0% 0.0% -0.0% rfib +0.0% 0.0% +0.0% +0.0% +0.0% rsa +0.0% 0.0% +0.0% +0.0% +0.0% scc +0.0% 0.0% +0.0% +0.0% +0.0% sched +0.0% 0.0% +0.0% +0.0% +0.0% scs +0.0% 0.0% +0.0% +0.0% 0.0% simple +0.0% 0.0% +0.0% +0.0% +0.0% solid +0.0% 0.0% +0.0% +0.0% 0.0% sorting +0.0% 0.0% +0.0% -0.0% 0.0% spectral-norm +0.0% 0.0% -0.0% -0.0% -0.0% sphere +0.0% 0.0% +0.0% -1.0% 0.0% symalg +0.0% 0.0% +0.0% +0.0% +0.0% tak +0.0% 0.0% +0.0% +0.0% +0.0% transform +0.0% 0.0% +0.4% -1.3% +0.0% treejoin +0.0% 0.0% +0.0% -0.0% 0.0% typecheck +0.0% 0.0% -0.0% +0.0% 0.0% veritas +0.0% 0.0% +0.0% -0.1% +0.0% wang +0.0% 0.0% +0.0% +0.0% +0.0% wave4main +0.0% 0.0% +0.0% 0.0% -0.0% wheel-sieve1 +0.0% 0.0% +0.0% +0.0% +0.0% wheel-sieve2 +0.0% 0.0% +0.0% +0.0% 0.0% x2n1 +0.0% 0.0% +0.0% +0.0% 0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -6.1% -0.0% Max +0.1% 0.0% +1.2% +0.0% +0.0% Geometric Mean +0.0% -0.0% +0.0% -0.1% -0.0% NoFib GC Results ================ -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- circsim +0.0% 0.0% -0.0% -0.0% -0.0% constraints +0.0% 0.0% -0.0% 0.0% -0.0% fibheaps +0.0% 0.0% 0.0% -0.0% -0.0% fulsom +0.0% 0.0% 0.0% -0.6% -0.0% gc_bench +0.0% 0.0% 0.0% 0.0% -0.0% hash +0.0% 0.0% -0.0% -0.0% -0.0% lcss +0.0% 0.0% 0.0% -0.0% 0.0% mutstore1 +0.0% 0.0% 0.0% -0.0% -0.0% mutstore2 +0.0% 0.0% +0.0% -0.0% -0.0% power +0.0% 0.0% -0.0% 0.0% -0.0% spellcheck +0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -0.6% -0.0% Max +0.0% 0.0% +0.0% 0.0% 0.0% Geometric Mean +0.0% +0.0% +0.0% -0.1% +0.0% Fixes #14373 These performance regressions appear to be a fluke in CI. See the discussion in !1742 for details. Metric Increase: T6048 T12234 T12425 Naperian T12150 T5837 T13035 - - - - - ee07421f by Simon Peyton Jones at 2019-12-06T21:21:14-05:00 Work in progress on coercionLKind, coercionRKind This is a preliminary patch for #17515 - - - - - 0a4ca9eb by Simon Peyton Jones at 2019-12-06T21:21:14-05:00 Split up coercionKind This patch implements the idea in #17515, splitting `coercionKind` into: * `coercion{Left,Right}Kind`, which computes the left/right side of the pair * `coercionKind`, which computes the pair of coercible types This is reduces allocation since we frequently only need only one side of the pair. Specifically, we see the following improvements on x86-64 Debian 9: | test | new | old | relative chg. | | :------- | ---------: | ------------: | ------------: | | T5030 | 695537752 | 747641152.0 | -6.97% | | T5321Fun | 449315744 | 474009040.0 | -5.21% | | T9872a | 2611071400 | 2645040952.0 | -1.28% | | T9872c | 2957097904 | 2994260264.0 | -1.24% | | T12227 | 773435072 | 812367768.0 | -4.79% | | T12545 | 3142687224 | 3215714752.0 | -2.27% | | T14683 | 9392407664 | 9824775000.0 | -4.40% | Metric Decrease: T12545 T9872a T14683 T5030 T12227 T9872c T5321Fun T9872b - - - - - d46a72e1 by Gabor Greif at 2019-12-09T12:05:15-05:00 Fix comment typos The below is only necessary to fix the CI perf fluke that happened in 9897e8c8ef0b19a9571ef97a1d9bb050c1ee9121: ------------------------- Metric Decrease: T5837 T6048 T9020 T12425 T12234 T13035 T12150 Naperian ------------------------- - - - - - e3bba7e4 by Micha Wiedenmann at 2019-12-10T19:52:44-05:00 users guide: Motivation of DefaultSignatures - - - - - 843ceb38 by Ben Gamari at 2019-12-10T19:53:54-05:00 rts: Add a long form flag to enable the non-moving GC The old flag, `-xn`, was quite cryptic. Here we add `--nonmoving-gc` in addition. - - - - - 921d3238 by Ryan Scott at 2019-12-10T19:54:34-05:00 Ignore unary constraint tuples during typechecking (#17511) We deliberately avoid defining a magical `Unit%` class, for reasons that I have expounded upon in the newly added `Note [Ignore unary constraint tuples]` in `TcHsType`. However, a sneaky user could try to insert `Unit%` into their program by way of Template Haskell, leading to the interface-file error observed in #17511. To avoid this, any time we encounter a unary constraint tuple during typechecking, we drop the surrounding constraint tuple application. This is safe to do since `Unit% a` and `a` would be semantically equivalent (unlike other forms of unary tuples). Fixes #17511. - - - - - 436ec9f3 by Ben Gamari at 2019-12-10T19:55:37-05:00 gitlab-ci: Move changelog linting logic to shell script Allowing it to be easily used locally. - - - - - 2f6b434f by Ben Gamari at 2019-12-10T19:55:37-05:00 gitlab-ci: Move changelog linting logic to shell script Allowing it to be easily used locally. - - - - - 7a5a6e07 by Ben Gamari at 2019-12-10T19:56:25-05:00 base: Fix incorrect @since in GHC.Natural Fixes #17547. - - - - - 2bbfaf8a by Ben Gamari at 2019-12-10T19:57:01-05:00 hadrian: AArch64 supports the GHCi interpreter and SMP I'm not sure how this was omitted from the list of supported architectures. - - - - - 8f1ceb67 by John Ericson at 2019-12-10T19:57:39-05:00 Move Int# section of primops.txt.pp This matches the organization of the fixed-sized ones, and keeps each Int* next to its corresponding Word*. - - - - - 7a823b0f by John Ericson at 2019-12-10T19:57:39-05:00 Move Int64# and Word64# sections of primops.txt.pp This way it is next to the other fixed-sized ones. - - - - - 8dd9929a by Ben Gamari at 2019-12-10T19:58:19-05:00 testsuite: Add (broken) test for #17510 - - - - - 6e47a76a by Ben Gamari at 2019-12-10T19:58:59-05:00 Re-layout validate script This script was previously a whitespace nightmare. - - - - - f80c4a66 by Crazycolorz5 at 2019-12-11T14:12:17-05:00 rts: Specialize hashing at call site rather than in struct. Separate word and string hash tables on the type level, and do not store the hashing function. Thus when a different hash function is desire it is provided upon accessing the table. This is worst case the same as before the change, and in the majority of cases is better. Also mark the functions for aggressive inlining to improve performance. {F1686506} Reviewers: bgamari, erikd, simonmar Subscribers: rwbarton, thomie, carter GHC Trac Issues: #13165 Differential Revision: https://phabricator.haskell.org/D4889 - - - - - 2d1b9619 by Richard Eisenberg at 2019-12-11T14:12:55-05:00 Warn on inferred polymorphic recursion Silly users sometimes try to use visible dependent quantification and polymorphic recursion without a CUSK or SAK. This causes unexpected errors. So we now adjust expectations with a bit of helpful messaging. Closes #17541 and closes #17131. test cases: dependent/should_fail/T{17541{,b},17131} - - - - - 4dde485e by Oleg Grenrus at 2019-12-12T02:24:46-05:00 Add --show-unit-ids flag to ghc-pkg I only added it into --simple-output and ghc-pkg check output; there are probably other places where it can be adopted. - - - - - e6e1ec08 by Ben Gamari at 2019-12-12T02:25:33-05:00 testsuite: Simplify and clarify performance test baseline search The previous implementation was extremely complicated, seemingly to allow the local and CI namespaces to be searched incrementally. However, it's quite unclear why this is needed and moreover the implementation seems to have had quadratic runtime cost in the search depth(!). - - - - - 29c4609c by Ben Gamari at 2019-12-12T02:26:19-05:00 testsuite: Add test for #17549 - - - - - 9f0ee253 by Ben Gamari at 2019-12-12T02:26:56-05:00 gitlab-ci: Move -dwarf and -debug jobs to full-build stage This sacrifices some precision in favor of improving parallelism. - - - - - 7179b968 by Ben Gamari at 2019-12-12T02:27:34-05:00 Revert "rts: Drop redundant flags for libffi" This seems to have regressed builds using `--with-system-libffi` (#17520). This reverts commit 3ce18700f80a12c48a029b49c6201ad2410071bb. - - - - - cc7d5650 by Oleg Grenrus at 2019-12-16T10:20:56+02:00 Having no shake upper bound is irresposible Given that shake is far from "done" API wise, and is central component to the build system. - - - - - 9431f905 by Oleg Grenrus at 2019-12-16T10:55:50+02:00 Add index-state to hadrian/cabal.project Then one is freer to omit upper bounds, as we won't pick any new entries on Hackage while building hadrian itself. - - - - - 3e17a866 by Krzysztof Gogolewski at 2019-12-16T19:31:44-05:00 Remove dataConSig As suggested in #17291 - - - - - 75355fde by Krzysztof Gogolewski at 2019-12-16T19:31:44-05:00 Use "OrCoVar" functions less As described in #17291, we'd like to separate coercions and expressions in a more robust fashion. This is a small step in this direction. - `mkLocalId` now panicks on a covar. Calls where this was not the case were changed to `mkLocalIdOrCoVar`. - Don't use "OrCoVar" functions in places where we know the type is not a coercion. - - - - - f9686e13 by Richard Eisenberg at 2019-12-16T19:32:21-05:00 Do more validity checks for quantified constraints Close #17583. Test case: typecheck/should_fail/T17563 - - - - - af763765 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Fix Windows artifact collection Variable interpolation in gitlab-ci.yml apparently doesn't work. Sigh. - - - - - e6d4b902 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Use xz --threads on Debian 10 - - - - - 8ba650e9 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Allow debian 8 build to fail The python release shipped with deb8 (3.3) is too old for our testsuite driver. - - - - - ac25a3f6 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Use xz --threads on Alpine - - - - - cc628088 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Another approach for xz detection - - - - - 37d788ab by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Re-add release-x86_64-deb9 job Also eliminate some redundancy. - - - - - f8279138 by Ben Gamari at 2019-12-16T19:33:01-05:00 gitlab-ci: Drop redundant release-x86_64-linux-deb9 job - - - - - 8148ff06 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark cgrun057 as broken on ARMv7 Due to #17554. It's very surprising that this only occurs on ARMv7 but this is the only place I've seen this failure thusfar. - - - - - 85e5696d by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark prog001 as fragile on ARMv7 Due to #17555. - - - - - a5f0aab0 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T10272 as broken on ARMv7 Due to #17556. - - - - - 1e6827c6 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T13825-debugger as broken on ARMv7 Due to #17557. - - - - - 7cef0b7d by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T14028 as broken on ARMv7 Due to #17558. - - - - - 6ea4eb4b by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Make ghc_built_by_llvm check more precise Previously it would hackily look at the flavour name to determine whether LLVM was used to build stage2 ghc. However, this didn't work at all with Hadrian and would miss cases like ARM where we use the LLVM backend by default. See #16087 for the motivation for why ghc_built_by_llvm is needed at all. This should catch one of the ARMv7 failures described in #17555. - - - - - c3e82bf7 by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark T5435_* tests as broken on ARM `T5435_v_asm_a`, `T5435_v_asm_b`, and `T5435_v_gcc` all fail on ARMv7. See #17559. - - - - - eb2aa851 by Ben Gamari at 2019-12-17T07:24:40-05:00 gitlab-ci: Don't allow armv7 jobs to fail - - - - - efc92216 by Ben Gamari at 2019-12-17T07:24:40-05:00 Revert "testsuite: Mark cgrun057 as broken on ARMv7" This reverts commit 6cfc47ec8a478e1751cb3e7338954da1853c3996. - - - - - 1d2bb9eb by Ben Gamari at 2019-12-17T07:24:40-05:00 testsuite: Mark print002 as fragile on ARM Due to #17557. Also accepting spurious performance change. Metric Decrease: T1969 - - - - - 41f4e4fb by Josh Meredith at 2019-12-17T07:25:17-05:00 Fix ambiguous occurence error when building Hadrian - - - - - 4374983a by Josh Meredith at 2019-12-17T07:25:17-05:00 Rename SphinxMode constructors - - - - - a8f7ecd5 by Josh Meredith at 2019-12-17T07:25:17-05:00 Use *Mode suffix instead of *M - - - - - 58655b9d by Sylvain Henry at 2019-12-18T13:43:37+01:00 Add GHC-API logging hooks * Add 'dumpAction' hook to DynFlags. It allows GHC API users to catch dumped intermediate codes and information. The format of the dump (Core, Stg, raw text, etc.) is now reported allowing easier automatic handling. * Add 'traceAction' hook to DynFlags. Some dumps go through the trace mechanism (for instance unfoldings that have been considered for inlining). This is problematic because: 1) dumps aren't written into files even with -ddump-to-file on 2) dumps are written on stdout even with GHC API 3) in this specific case, dumping depends on unsafe globally stored DynFlags which is bad for GHC API users We introduce 'traceAction' hook which allows GHC API to catch those traces and to avoid using globally stored DynFlags. * Avoid dumping empty logs via dumpAction/traceAction (but still write empty files to keep the existing behavior) - - - - - fad866e0 by Moritz Kiefer at 2019-12-19T11:15:39-05:00 Avoid race condition in hDuplicateTo In our codebase we have some code along the lines of ``` newStdout <- hDuplicate stdout stderr `hDuplicateTo` stdout ``` to avoid stray `putStrLn`s from corrupting a protocol (LSP) that is run over stdout. On CI we have seen a bunch of issues where `dup2` returned `EBUSY` so this fails with `ResourceExhausted` in Haskell. I’ve spent some time looking at the docs for `dup2` and the code in `base` and afaict the following race condition is being triggered here: 1. The user calls `hDuplicateTo stderr stdout`. 2. `hDuplicateTo` calls `hClose_help stdout_`, this closes the file handle for stdout. 3. The file handle for stdout is now free, so another thread allocating a file might get stdout. 4. If `dup2` is called while `stdout` (now pointing to something else) is half-open, it returns EBUSY. I think there might actually be an even worse case where `dup2` is run after FD 1 is fully open again. In that case, you will end up not just redirecting the original stdout to stderr but also the whatever resulted in that file handle being allocated. As far as I can tell, `dup2` takes care of closing the file handle itself so there is no reason to do this in `hDuplicateTo`. So this PR replaces the call to `hClose_help` by the only part of `hClose_help` that we actually care about, namely, `flushWriteBuffer`. I tested this on our codebase fairly extensively and haven’t been able to reproduce the issue with this patch. - - - - - 0c114c65 by Sylvain Henry at 2019-12-19T11:16:17-05:00 Handle large ARR_WORDS in heap census (fix #17572) We can do a heap census with a non-profiling RTS. With a non-profiling RTS we don't zero superfluous bytes of shrunk arrays hence a need to handle the case specifically to avoid a crash. Revert part of a586b33f8e8ad60b5c5ef3501c89e9b71794bbed - - - - - 1a0d1a65 by John Ericson at 2019-12-20T10:50:22-05:00 Deduplicate copied monad failure handler code - - - - - 70e56b27 by Ryan Scott at 2019-12-20T10:50:57-05:00 lookupBindGroupOcc: recommend names in the same namespace (#17593) Previously, `lookupBindGroupOcc`'s error message would recommend all similar names in scope, regardless of whether they were type constructors, data constructors, or functions, leading to the confusion witnessed in #17593. This is easily fixed by only recommending names in the same namespace, using the `nameSpacesRelated` function. Fixes #17593. - - - - - 3c12355e by Stefan Schulze Frielinghaus at 2019-12-24T01:03:44-05:00 Fix endian handling w.r.t. CPP macro WORDS_BIGENDIAN Include header file `ghcautoconf.h` where the CPP macro `WORDS_BIGENDIAN` is defined. This finally fixes #17337 (in conjunction with commit 6c59cc71dc). - - - - - 11f8eef5 by Stefan Schulze Frielinghaus at 2019-12-24T01:03:44-05:00 fixup! Fix endian handling w.r.t. CPP macro WORDS_BIGENDIAN - - - - - 40327b03 by Sylvain Henry at 2019-12-24T01:04:24-05:00 Remove outdated comment - - - - - aeea92ef by Sylvain Henry at 2019-12-25T19:23:54-05:00 Switch to ReadTheDocs theme for the user-guide - - - - - 26493eab by Gabor Greif at 2019-12-25T19:24:32-05:00 Fix copy-paste error in comment - - - - - 776df719 by Gabor Greif at 2019-12-25T19:24:32-05:00 Fix comment about minimal gcc version to be consistent what FP_GCC_VERSION requires - - - - - 3b17114d by Ömer Sinan Ağacan at 2019-12-26T14:09:11-05:00 Minor refactor in ghc.cabal.in: - Remove outdated comments - Move cutils.c from parser to cbits - Remove unused cutils.h - - - - - 334290b6 by Ryan Scott at 2019-12-26T14:09:48-05:00 Replace panic/notHandled with noExtCon in DsMeta There are many spots in `DsMeta` where `panic` or `notHandled` is used after pattern-matching on a TTG extension constructor. This is overkill, however, as using `noExtCon` would work just as well. This patch switches out these panics for `noExtCon`. - - - - - 68252aa3 by Ben Gamari at 2019-12-27T15:11:38-05:00 testsuite: Skip T17499 when built against integer-simple Since it routinely times out in CI. - - - - - 0c51aeeb by Gabor Greif at 2019-12-27T15:12:17-05:00 suppress popup dialog about missing Xcode at configure tested with `bash` and `zsh`. - - - - - 8d76bcc2 by Gabor Greif at 2019-12-27T15:12:17-05:00 while at it rename XCode to the official Xcode - - - - - 47a68205 by Ben Gamari at 2019-12-27T15:12:55-05:00 testsuite: Mark cgrun057 as fragile on ARM As reported in #17554. Only marking on ARM for now although there is evidence to suggest that the issue may occur on other platforms as well. - - - - - d03dec8f by Gabor Greif at 2019-12-27T15:13:32-05:00 use shell variable CcLlvmBackend for test Previously we used `AC_DEFINE`d variable `CC_LLVM_BACKEND` which has an empty shell expansion. - - - - - 2528e684 by Ben Gamari at 2019-12-30T06:51:32-05:00 driver: Include debug level in the recompilation check hash Fixes #17586. - - - - - f14bb50b by Ben Gamari at 2019-12-30T06:52:09-05:00 rts: Ensure that nonmoving gc isn't used with profiling - - - - - b426de37 by Ben Gamari at 2019-12-30T06:52:45-05:00 llvmGen: Ensure that entry labels don't have predecessors The LLVM IR forbids the entry label of a procedure from having any predecessors. In the case of a simple looping function the LLVM code generator broke this invariant, as noted in #17589. Fix this by moving the function prologue to its own basic block, as suggested by @kavon in #11649. Fixes #11649 and #17589. - - - - - 613f7265 by Ben Gamari at 2019-12-30T06:52:45-05:00 llvmGen: Drop old fix for #11649 This was a hack which is no longer necessary now since we introduce a dedicated entry block for each procedure. - - - - - fdeffa5e by Ben Gamari at 2019-12-30T06:53:23-05:00 rts: Error on invalid --numa flags Previously things like `+RTS --numa-debug` would enable NUMA support, despite being an invalid flag. - - - - - 9ce3ba68 by Ben Gamari at 2019-12-30T06:53:23-05:00 rts: Fix --debug-numa mode under Docker As noted in #17606, Docker disallows the get_mempolicy syscall by default. This caused numerous tests to fail under CI in the `debug_numa` way. Avoid this by disabling the NUMA probing logic when --debug-numa is in use, instead setting n_numa_nodes in RtsFlags.c. Fixes #17606. - - - - - 5baa2a43 by Ben Gamari at 2019-12-30T06:54:01-05:00 testsuite: Disable derefnull when built with LLVM LLVM does not guarantee any particular semantics when dereferencing null pointers. Consequently, this test actually passes when built with the LLVM backend. - - - - - bd544d3d by Ben Gamari at 2019-12-30T06:54:38-05:00 hadrian: Track hash of Cabal Setup builder arguments Lest we fail to rebuild when they change. Fixes #17611. - - - - - 6e2c495e by Ben Gamari at 2019-12-30T06:55:19-05:00 TcIface: Fix inverted logic in typechecking of source ticks Previously we would throw away source ticks when the debug level was non-zero. This is precisely the opposite of what was intended. Fixes #17616. Metric Decrease: T13056 T9020 T9961 T12425 - - - - - 7fad387d by Ben Gamari at 2019-12-30T06:55:55-05:00 perf_notes: Add --zero-y argument This makes it easier to see the true magnitude of fluctuations. Also do some house-keeping in the argument parsing department. - - - - - 0d42b287 by Ben Gamari at 2019-12-30T06:55:55-05:00 testsuite: Enlarge acceptance window for T1969 As noted in #17624, it's quite unstable, especially, for some reason, on i386 and armv7 (something about 32-bit platforms perhaps?). Metric Increase: T1969 - - - - - eb608235 by Sylvain Henry at 2019-12-31T14:22:32-05:00 Module hierarchy (#13009): Stg - - - - - d710fd66 by Vladislav Zavialov at 2019-12-31T14:23:10-05:00 Testsuite: update some Haddock tests Fixed tests: * haddockA039: added to all.T * haddockE004: replaced with T17561 (marked as expect_broken) New tests: * haddockA040: deriving clause for a data instance * haddockA041: haddock and CPP #include - - - - - 859ebdd4 by Kevin Buhr at 2019-12-31T23:44:39-05:00 Add "-Iw" RTS flag for minimum wait between idle GCs (#11134) - - - - - dd4b6551 by Kevin Buhr at 2019-12-31T23:44:39-05:00 Add additional Note explaining the -Iw flag - - - - - c4279ff1 by Kevin Buhr at 2019-12-31T23:44:39-05:00 Fix some sloppy indentation - - - - - b84c09d5 by Ömer Sinan Ağacan at 2019-12-31T23:45:19-05:00 Tweak Cmm dumps to avoid generating sections for empty groups When dumping Cmm groups check if the group is empty, to avoid generating empty sections in dump files like ==================== Output Cmm ==================== [] Also fixes a few bad indentation in the code around changes. - - - - - b2e0323f by Gabor Greif at 2020-01-03T21:22:36-05:00 Simplify mrStr - - - - - 3c9dc06b by Brian Wignall at 2020-01-04T15:55:06-05:00 Fix typos, via a Levenshtein-style corrector - - - - - d561c8f6 by Sylvain Henry at 2020-01-04T15:55:46-05:00 Add Cmm related hooks * stgToCmm hook * cmmToRawCmm hook These hooks are used by Asterius and could be useful to other clients of the GHC API. It increases the Parser dependencies (test CountParserDeps) to 184. It's still less than 200 which was the initial request (cf https://mail.haskell.org/pipermail/ghc-devs/2019-September/018122.html) so I think it's ok to merge this. - - - - - ae6b6276 by Oleg Grenrus at 2020-01-04T15:56:22-05:00 Update to Cabal submodule to v3.2.0.0-alpha3 Metric Increase: haddock.Cabal - - - - - 073f7cfd by Vladislav Zavialov at 2020-01-04T15:56:59-05:00 Add lexerDbg to dump the tokens fed to the parser This a small utility function that comes in handy when debugging the lexer and the parser. - - - - - 558d4d4a by Sylvain Henry at 2020-01-04T15:57:38-05:00 Split integerGmpInternals test in several parts This is to prepare for ghc-bignum which implements some but not all of gmp functions. - - - - - 4056b966 by Ben Gamari at 2020-01-04T15:58:15-05:00 testsuite: Mark cgrun057 as fragile on all platforms I have seen this fail both on x86-64/Debian 9 and armv7/Debian 9 See #17554. - - - - - 5ffea0c6 by Tamar Christina at 2020-01-06T18:38:37-05:00 Fix overflow. - - - - - 99a9f51b by Sylvain Henry at 2020-01-06T18:39:22-05:00 Module hierarchy: Iface (cf #13009) - - - - - 7aa4a061 by Ben Gamari at 2020-01-07T13:11:48-05:00 configure: Only check GCC version if CC is GCC Also refactor FP_GCC_EXTRA_FLAGS in a few ways: * We no longer support compilers which lack support for -fno-builtin and -fwrapv so remove the condition on GccVersion * These flags are only necessary when using the via-C backend so make them conditional on Unregisterised. Fixes #15742. - - - - - 0805ed7e by John Ericson at 2020-01-07T13:12:25-05:00 Use non-empty lists to remove partiality in matching code - - - - - 7844f3a8 by Ben Gamari at 2020-01-07T13:13:02-05:00 testsuite: Mark T17073 as broken on Windows Due to #17607. - - - - - acf40cae by Ben Gamari at 2020-01-07T13:13:02-05:00 gitlab-ci: Disallow Windows from failing - - - - - 34bc02c7 by Ben Gamari at 2020-01-07T13:13:02-05:00 configure: Find Python3 for testsuite In addition, we prefer the Mingw64 Python distribution on Windows due to #17483. - - - - - e35fe8d5 by Ben Gamari at 2020-01-07T13:13:02-05:00 testsuite: Fix Windows platform test Previously we used platform.system() and while this worked fine (e.g. returned `Windows`, as expected) locally under both msys and MingW64 Python distributions, it inexplicably returned `MINGW64_NT-10.0` under MingW64 Python on CI. It seems os.name is more reliable so we now use that instead.. - - - - - 48ef6217 by Ben Gamari at 2020-01-07T13:13:39-05:00 gitlab-ci: Rename push-test-metrics.sh to test-metrics.sh Refactoring to follow. - - - - - 2234fa92 by Ben Gamari at 2020-01-07T13:13:39-05:00 gitlab-ci: Pull test metrics before running testsuite Otherwise the testsuite driver may not have an up-to-date baseline. - - - - - 1ca9adbc by Sylvain Henry at 2020-01-07T13:14:18-05:00 Remove `parallel` check from configure.ac `parallel` is no longer a submodule since 3cb063c805ec841ca33b8371ef8aba9329221b6c - - - - - b69a3460 by Ryan Scott at 2020-01-07T13:14:57-05:00 Monomorphize HsModule to GhcPs (#17642) Analyzing the call sites for `HsModule` reveals that it is only ever used with parsed code (i.e., `GhcPs`). This simplifies `HsModule` by concretizing its `pass` parameter to always be `GhcPs`. Fixes #17642. - - - - - d491a679 by Sylvain Henry at 2020-01-08T06:16:31-05:00 Module hierarchy: Renamer (cf #13009) - - - - - d589410f by Ben Gamari at 2020-01-08T06:17:09-05:00 Bump haskeline submodule to 0.8.0.1 (cherry picked from commit feb3b955402d53c3875dd7a9a39f322827e5bd69) - - - - - 923a1272 by Ryan Scott at 2020-01-08T06:17:47-05:00 Print Core type applications with no whitespace after @ (#17643) This brings the pretty-printer for Core in line with how visible type applications are normally printed: namely, with no whitespace after the `@` character (i.e., `f @a` instead of `f @ a`). While I'm in town, I also give the same treatment to type abstractions (i.e., `\(@a)` instead of `\(@ a)`) and coercion applications (i.e., `f @~x` instead of `f @~ x`). Fixes #17643. - - - - - 49f83a0d by Adam Sandberg Eriksson at 2020-01-12T21:28:09-05:00 improve docs for HeaderInfo.getImports [skip ci] - - - - - 9129210f by Matthew Pickering at 2020-01-12T21:28:47-05:00 Overloaded Quotation Brackets (#246) This patch implements overloaded quotation brackets which generalise the desugaring of all quotation forms in terms of a new minimal interface. The main change is that a quotation, for example, [e| 5 |], will now have type `Quote m => m Exp` rather than `Q Exp`. The `Quote` typeclass contains a single method for generating new names which is used when desugaring binding structures. The return type of functions from the `Lift` type class, `lift` and `liftTyped` have been restricted to `forall m . Quote m => m Exp` rather than returning a result in a Q monad. More details about the feature can be read in the GHC proposal. https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0246-overloaded-bracket.rst - - - - - 350e2b78 by Richard Eisenberg at 2020-01-12T21:29:27-05:00 Don't zap to Any; error instead This changes GHC's treatment of so-called Naughty Quantification Candidates to issue errors, instead of zapping to Any. Close #16775. No new test cases, because existing ones cover this well. - - - - - 0b5ddc7f by Brian Wignall at 2020-01-12T21:30:08-05:00 Fix more typos, via an improved Levenshtein-style corrector - - - - - f732dbec by Ben Gamari at 2020-01-12T21:30:49-05:00 gitlab-ci: Retain bindists used by head.hackage for longer Previously we would keep them for two weeks. However, on the stable branches two weeks can easily elapse with no pushes. - - - - - c8636da5 by Sylvain Henry at 2020-01-12T21:31:30-05:00 Fix LANG=C for readelf invocation in T14999 The test fails when used with LANG=fr_FR.UTF-8 - - - - - 077a88de by Jean-Baptiste Mazon at 2020-01-12T21:32:08-05:00 users-guide/debug-info: typo “behivior” - - - - - 61916c5d by Simon Peyton Jones at 2020-01-12T21:32:44-05:00 Add comments about TH levels - - - - - 1fd766ca by Simon Peyton Jones at 2020-01-12T21:32:44-05:00 Comments about constraint floating - - - - - de01427e by Simon Peyton Jones at 2020-01-12T21:32:45-05:00 Minor refactor around quantified constraints This patch clarifies a dark corner of quantified constraints. * See Note [Yukky eq_sel for a HoleDest] in TcSMonad * Minor refactor, breaking out new function TcInteract.doTopReactEqPred - - - - - 30be3bf1 by Simon Peyton Jones at 2020-01-12T21:32:45-05:00 Comments in TcHsType - - - - - c5977d4d by Sebastian Graf at 2020-01-16T05:58:58-05:00 Better documentation for mkEtaWW [skip ci] So that hopefully I understand it faster next time. Also got rid of the confusing `orig_expr`, which makes the call site in `etaExpand` look out of sync with the passed `n` (which is not the original `n`). - - - - - 22c0bdc3 by John Ericson at 2020-01-16T05:59:37-05:00 Handle TagToEnum in the same big case as the other primops Before, it was a panic because it was handled above. But there must have been an error in my reasoning (another caller?) because #17442 reported the panic was hit. But, rather than figuring out what happened, I can just make it impossible by construction. By adding just a bit more bureaucracy in the return types, I can handle TagToEnum in the same case as all the others, so the big case is is now total, and the panic is removed. Fixes #17442 - - - - - ee5d63f4 by John Ericson at 2020-01-16T05:59:37-05:00 Get rid of OpDest `OpDest` was basically a defunctionalization. Just turn the code that cased on it into those functions, and call them directly. - - - - - 1ff55226 by John Ericson at 2020-01-16T06:00:16-05:00 Remove special case case of bool during STG -> C-- Allow removing the no longer needed cgPrimOp, getting rid of a small a small layer violation too. Change which made the special case no longer needed was #6135 / 6579a6c73082387f82b994305011f011d9d8382b, which dates back to 2013, making me feel better. - - - - - f416fe64 by Adam Wespiser at 2020-01-16T06:00:53-05:00 replace dead html link (fixes #17661) - - - - - f6bf2ce8 by Sebastian Graf at 2020-01-16T06:01:32-05:00 Revert "`exprOkForSpeculation` for Note [IO hack in the demand analyser]" This reverts commit ce64b397777408731c6dd3f5c55ea8415f9f565b on the grounds of the regression it would introduce in a couple of packages. Fixes #17653. Also undoes a slight metric increase in #13701 introduced by that commit that we didn't see prior to !1983. Metric Decrease: T13701 - - - - - a71323ff by Ben Gamari at 2020-01-17T08:43:16-05:00 gitlab-ci: Don't FORCE_SYMLINKS on Windows Not all runners have symlink permissions enabled. - - - - - 0499e3bc by Ömer Sinan Ağacan at 2020-01-20T15:31:33-05:00 Fix +RTS -Z flag documentation Stack squeezing is done on context switch, not on GC or stack overflow. Fix the documentation. Fixes #17685 [ci skip] - - - - - a661df91 by Ömer Sinan Ağacan at 2020-01-20T15:32:13-05:00 Document Stg.FVs module Fixes #17662 [ci skip] - - - - - db24e480 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Don't trash STG registers Fixes #13904. - - - - - f3d7fdb3 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Fix typo in readnone attribute - - - - - 442751c6 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Add lower-expect to the -O0 optimisation set @kavon says that this will improve block layout for stack checks. - - - - - e90ecc93 by Ben Gamari at 2020-01-20T15:32:52-05:00 llvmGen: Fix #14251 Fixes the calling convention for functions passing raw SSE-register values by adding padding as needed to get the values in the right registers. This problem cropped up when some args were unused an dropped from the live list. This folds together 2e23e1c7de01c92b038e55ce53d11bf9db993dd4 and 73273be476a8cc6c13368660b042b3b0614fd928 previously from @kavon. Metric Increase: T12707 ManyConstructors - - - - - 66e511a4 by Ben Gamari at 2020-01-20T15:33:28-05:00 testsuite: Preserve more information in framework failures Namely print the entire exception in hopes that this will help track down #17649. - - - - - b62b8cea by Ömer Sinan Ağacan at 2020-01-20T15:34:06-05:00 Remove deprecated -smp flag It was deprecated in 2012 with 46258b40 - - - - - 0c04a86a by Ben Gamari at 2020-01-20T15:34:43-05:00 gitlab-ci: Reenable submodule linter - - - - - 2bfabd22 by Ben Gamari at 2020-01-20T15:34:43-05:00 gitlab-ci: Allow submodule cleaning to fail on Windows Currently CI is inexplicably failing with ``` $ git submodule foreach git clean -xdf fatal: not a git repository: libffi-tarballs/../.git/modules/libffi-tarballs ``` I have no idea how this working tree got into such a state but we do need to fail more gracefully when it happens. Consequently, we allow the cleaning step to fail. - - - - - 14bced99 by Xavier Denis at 2020-01-20T15:35:21-05:00 Put the docs for :instances in alphabetical position - - - - - 7e0bb82b by Ben Gamari at 2020-01-20T15:35:57-05:00 Add missing Note [Improvement from Ground Wanteds] Closes #17659. - - - - - 17e43a7c by Ben Gamari at 2020-01-20T15:36:32-05:00 unregisterised: Fix declaration for stg_NO_FINALIZER Previously it had a redundant _entry suffix. We never noticed this previously presumably because we never generated references to it (however hard to believe this may be). However, it did start failing in !1304. - - - - - 3dae006f by PHO at 2020-01-20T15:37:08-05:00 Avoid ./configure failure on NetBSD - - - - - 738e2912 by Ben Gamari at 2020-01-24T13:42:56-05:00 testsuite: Widen acceptance window of T1969 I have seen >20% fluctuations in this number, leading to spurious failures. - - - - - ad4eb7a7 by Gabor Greif at 2020-01-25T05:19:07-05:00 Document the fact, that openFileBlocking can consume an OS thread indefinitely. Also state that a deadlock can happen with the non-threaded runtime. [ci skip] - - - - - be910728 by Sebastian Graf at 2020-01-25T05:19:46-05:00 `-ddump-str-signatures` dumps Text, not STG [skip ci] - - - - - 0e57d8a1 by Ömer Sinan Ağacan at 2020-01-25T05:20:27-05:00 Fix chaining tagged and untagged ptrs in compacting GC Currently compacting GC has the invariant that in a chain all fields are tagged the same. However this does not really hold: root pointers are not tagged, so when we thread a root we initialize a chain without a tag. When the pointed objects is evaluated and we have more pointers to it from the heap, we then add *tagged* fields to the chain (because pointers to it from the heap are tagged), ending up chaining fields with different tags (pointers from roots are NOT tagged, pointers from heap are). This breaks the invariant and as a result compacting GC turns tagged pointers into non-tagged. This later causes problem in the generated code where we do reads assuming that the pointer is aligned, e.g. 0x7(%rax) -- assumes that pointer is tagged 1 which causes misaligned reads. This caused #17088. We fix this using the "pointer tagging for large families" patch (#14373, !1742): - With the pointer tagging patch the GC can know what the tagged pointer to a CONSTR should be (previously we'd need to know the family size -- large families are always tagged 1, small families are tagged depending on the constructor). - Since we now know what the tags should be we no longer need to store the pointer tag in the info table pointers when forming chains in the compacting GC. As a result we no longer need to tag pointers in chains with 1/2 depending on whether the field points to an info table pointer, or to another field: an info table pointer is always tagged 0, everything else in the chain is tagged 1. The lost tags in pointers can be retrieved by looking at the info table. Finally, instead of using tag 1 for fields and tag 0 for info table pointers, we use two different tags for fields: - 1 for fields that have untagged pointers - 2 for fields that have tagged pointers When unchaining we then look at the pointer to a field, and depending on its tag we either leave a tagged pointer or an untagged pointer in the field. This allows chaining untagged and tagged fields together in compacting GC. Fixes #17088 Nofib results ------------- Binaries are smaller because of smaller `Compact.c` code. make mode=fast EXTRA_RUNTEST_OPTS="-cachegrind" EXTRA_HC_OPTS="-with-rtsopts=-c" NoFibRuns=1 -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS -0.3% 0.0% +0.0% +0.0% +0.0% CSD -0.3% 0.0% +0.0% +0.0% +0.0% FS -0.3% 0.0% +0.0% -0.0% -0.0% S -0.3% 0.0% +5.4% +0.8% +3.9% VS -0.3% 0.0% +0.0% -0.0% -0.0% VSD -0.3% 0.0% -0.0% -0.0% -0.2% VSM -0.3% 0.0% +0.0% +0.0% +0.0% anna -0.1% 0.0% +0.0% +0.0% +0.0% ansi -0.3% 0.0% +0.1% +0.0% +0.0% atom -0.2% 0.0% +0.0% +0.0% +0.0% awards -0.2% 0.0% +0.0% 0.0% -0.0% banner -0.3% 0.0% +0.0% +0.0% +0.0% bernouilli -0.3% 0.0% +0.1% +0.0% +0.0% binary-trees -0.2% 0.0% +0.0% 0.0% +0.0% boyer -0.3% 0.0% +0.2% +0.0% +0.0% boyer2 -0.2% 0.0% +0.2% +0.1% +0.0% bspt -0.2% 0.0% +0.0% +0.0% +0.0% cacheprof -0.2% 0.0% +0.0% +0.0% +0.0% calendar -0.3% 0.0% +0.0% +0.0% +0.0% cichelli -0.3% 0.0% +1.1% +0.2% +0.5% circsim -0.2% 0.0% +0.0% -0.0% -0.0% clausify -0.3% 0.0% +0.0% -0.0% -0.0% comp_lab_zift -0.2% 0.0% +0.0% +0.0% +0.0% compress -0.3% 0.0% +0.0% +0.0% +0.0% compress2 -0.3% 0.0% +0.0% -0.0% -0.0% constraints -0.3% 0.0% +0.2% +0.1% +0.1% cryptarithm1 -0.3% 0.0% +0.0% -0.0% 0.0% cryptarithm2 -0.3% 0.0% +0.0% +0.0% +0.0% cse -0.3% 0.0% +0.0% +0.0% +0.0% digits-of-e1 -0.3% 0.0% +0.0% +0.0% +0.0% digits-of-e2 -0.3% 0.0% +0.0% +0.0% -0.0% dom-lt -0.2% 0.0% +0.0% +0.0% +0.0% eliza -0.2% 0.0% +0.0% +0.0% +0.0% event -0.3% 0.0% +0.1% +0.0% -0.0% exact-reals -0.2% 0.0% +0.0% +0.0% +0.0% exp3_8 -0.3% 0.0% +0.0% +0.0% +0.0% expert -0.2% 0.0% +0.0% +0.0% +0.0% fannkuch-redux -0.3% 0.0% -0.0% -0.0% -0.0% fasta -0.3% 0.0% +0.0% +0.0% +0.0% fem -0.2% 0.0% +0.1% +0.0% +0.0% fft -0.2% 0.0% +0.0% -0.0% -0.0% fft2 -0.2% 0.0% +0.0% -0.0% +0.0% fibheaps -0.3% 0.0% +0.0% -0.0% -0.0% fish -0.3% 0.0% +0.0% +0.0% +0.0% fluid -0.2% 0.0% +0.4% +0.1% +0.1% fulsom -0.2% 0.0% +0.0% +0.0% +0.0% gamteb -0.2% 0.0% +0.1% +0.0% +0.0% gcd -0.3% 0.0% +0.0% +0.0% +0.0% gen_regexps -0.3% 0.0% +0.0% -0.0% -0.0% genfft -0.3% 0.0% +0.0% +0.0% +0.0% gg -0.2% 0.0% +0.7% +0.3% +0.2% grep -0.2% 0.0% +0.0% +0.0% +0.0% hidden -0.2% 0.0% +0.0% +0.0% +0.0% hpg -0.2% 0.0% +0.1% +0.0% +0.0% ida -0.3% 0.0% +0.0% +0.0% +0.0% infer -0.2% 0.0% +0.0% -0.0% -0.0% integer -0.3% 0.0% +0.0% +0.0% +0.0% integrate -0.2% 0.0% +0.0% +0.0% +0.0% k-nucleotide -0.2% 0.0% +0.0% +0.0% -0.0% kahan -0.3% 0.0% -0.0% -0.0% -0.0% knights -0.3% 0.0% +0.0% -0.0% -0.0% lambda -0.3% 0.0% +0.0% -0.0% -0.0% last-piece -0.3% 0.0% +0.0% +0.0% +0.0% lcss -0.3% 0.0% +0.0% +0.0% 0.0% life -0.3% 0.0% +0.0% -0.0% -0.0% lift -0.2% 0.0% +0.0% +0.0% +0.0% linear -0.2% 0.0% +0.0% +0.0% +0.0% listcompr -0.3% 0.0% +0.0% +0.0% +0.0% listcopy -0.3% 0.0% +0.0% +0.0% +0.0% maillist -0.3% 0.0% +0.0% -0.0% -0.0% mandel -0.2% 0.0% +0.0% +0.0% +0.0% mandel2 -0.3% 0.0% +0.0% +0.0% +0.0% mate -0.2% 0.0% +0.0% +0.0% +0.0% minimax -0.3% 0.0% +0.0% +0.0% +0.0% mkhprog -0.2% 0.0% +0.0% +0.0% +0.0% multiplier -0.3% 0.0% +0.0% -0.0% -0.0% n-body -0.2% 0.0% -0.0% -0.0% -0.0% nucleic2 -0.2% 0.0% +0.0% +0.0% +0.0% para -0.2% 0.0% +0.0% -0.0% -0.0% paraffins -0.3% 0.0% +0.0% -0.0% -0.0% parser -0.2% 0.0% +0.0% +0.0% +0.0% parstof -0.2% 0.0% +0.8% +0.2% +0.2% pic -0.2% 0.0% +0.1% -0.1% -0.1% pidigits -0.3% 0.0% +0.0% +0.0% +0.0% power -0.2% 0.0% +0.0% -0.0% -0.0% pretty -0.3% 0.0% -0.0% -0.0% -0.1% primes -0.3% 0.0% +0.0% +0.0% -0.0% primetest -0.2% 0.0% +0.0% -0.0% -0.0% prolog -0.3% 0.0% +0.0% -0.0% -0.0% puzzle -0.3% 0.0% +0.0% +0.0% +0.0% queens -0.3% 0.0% +0.0% +0.0% +0.0% reptile -0.2% 0.0% +0.2% +0.1% +0.0% reverse-complem -0.3% 0.0% +0.0% +0.0% +0.0% rewrite -0.3% 0.0% +0.0% -0.0% -0.0% rfib -0.2% 0.0% +0.0% +0.0% -0.0% rsa -0.2% 0.0% +0.0% +0.0% +0.0% scc -0.3% 0.0% -0.0% -0.0% -0.1% sched -0.3% 0.0% +0.0% +0.0% +0.0% scs -0.2% 0.0% +0.1% +0.0% +0.0% simple -0.2% 0.0% +3.4% +1.0% +1.8% solid -0.2% 0.0% +0.0% +0.0% +0.0% sorting -0.3% 0.0% +0.0% +0.0% +0.0% spectral-norm -0.2% 0.0% -0.0% -0.0% -0.0% sphere -0.2% 0.0% +0.0% +0.0% +0.0% symalg -0.2% 0.0% +0.0% +0.0% +0.0% tak -0.3% 0.0% +0.0% +0.0% -0.0% transform -0.2% 0.0% +0.2% +0.1% +0.1% treejoin -0.3% 0.0% +0.2% -0.0% -0.1% typecheck -0.3% 0.0% +0.0% +0.0% +0.0% veritas -0.1% 0.0% +0.0% +0.0% +0.0% wang -0.2% 0.0% +0.0% -0.0% -0.0% wave4main -0.3% 0.0% +0.0% -0.0% -0.0% wheel-sieve1 -0.3% 0.0% +0.0% -0.0% -0.0% wheel-sieve2 -0.3% 0.0% +0.0% -0.0% -0.0% x2n1 -0.3% 0.0% +0.0% +0.0% +0.0% -------------------------------------------------------------------------------- Min -0.3% 0.0% -0.0% -0.1% -0.2% Max -0.1% 0.0% +5.4% +1.0% +3.9% Geometric Mean -0.3% -0.0% +0.1% +0.0% +0.1% -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- circsim -0.2% 0.0% +1.6% +0.4% +0.7% constraints -0.3% 0.0% +4.3% +1.5% +2.3% fibheaps -0.3% 0.0% +3.5% +1.2% +1.3% fulsom -0.2% 0.0% +3.6% +1.2% +1.8% gc_bench -0.3% 0.0% +4.1% +1.3% +2.3% hash -0.3% 0.0% +6.6% +2.2% +3.6% lcss -0.3% 0.0% +0.7% +0.2% +0.7% mutstore1 -0.3% 0.0% +4.8% +1.4% +2.8% mutstore2 -0.3% 0.0% +3.4% +1.0% +1.7% power -0.2% 0.0% +2.7% +0.6% +1.9% spellcheck -0.3% 0.0% +1.1% +0.4% +0.4% -------------------------------------------------------------------------------- Min -0.3% 0.0% +0.7% +0.2% +0.4% Max -0.2% 0.0% +6.6% +2.2% +3.6% Geometric Mean -0.3% +0.0% +3.3% +1.0% +1.8% Metric changes -------------- While it sounds ridiculous, this change causes increased allocations in the following tests. We concluded that this change can't cause a difference in allocations and decided to land this patch. Fluctuations in "bytes allocated" metric is tracked in #17686. Metric Increase: Naperian T10547 T12150 T12234 T12425 T13035 T5837 T6048 - - - - - 8038cbd9 by Sebastian Graf at 2020-01-25T05:21:05-05:00 PmCheck: Formulate as translation between Clause Trees We used to check `GrdVec`s arising from multiple clauses and guards in isolation. That resulted in a split between `pmCheck` and `pmCheckGuards`, the implementations of which were similar, but subtly different in detail. Also the throttling mechanism described in `Note [Countering exponential blowup]` ultimately got quite complicated because it had to cater for both checking functions. This patch realises that pattern match checking doesn't just consider single guarded RHSs, but that it's always a whole set of clauses, each of which can have multiple guarded RHSs in turn. We do so by translating a list of `Match`es to a `GrdTree`: ```haskell data GrdTree = Rhs !RhsInfo | Guard !PmGrd !GrdTree -- captures lef-to-right match semantics | Sequence !GrdTree !GrdTree -- captures top-to-bottom match semantics | Empty -- For -XEmptyCase, neutral element of Sequence ``` Then we have a function `checkGrdTree` that matches a given `GrdTree` against an incoming set of values, represented by `Deltas`: ```haskell checkGrdTree :: GrdTree -> Deltas -> CheckResult ... ``` Throttling is isolated to the `Sequence` case and becomes as easy as one would expect: When the union of uncovered values becomes too big, just return the original incoming `Deltas` instead (which is always a superset of the union, thus a sound approximation). The returned `CheckResult` contains two things: 1. The set of values that were not covered by any of the clauses, for exhaustivity warnings. 2. The `AnnotatedTree` that enriches the syntactic structure of the input program with divergence and inaccessibility information. This is `AnnotatedTree`: ```haskell data AnnotatedTree = AccessibleRhs !RhsInfo | InaccessibleRhs !RhsInfo | MayDiverge !AnnotatedTree | SequenceAnn !AnnotatedTree !AnnotatedTree | EmptyAnn ``` Crucially, `MayDiverge` asserts that the tree may force diverging values, so not all of its wrapped clauses can be redundant. While the set of uncovered values can be used to generate the missing equations for warning messages, redundant and proper inaccessible equations can be extracted from `AnnotatedTree` by `redundantAndInaccessibleRhss`. For this to work properly, the interface to the Oracle had to change. There's only `addPmCts` now, which takes a bag of `PmCt`s. There's a whole bunch of `PmCt` variants to replace the different oracle functions from before. The new `AnnotatedTree` structure allows for more accurate warning reporting (as evidenced by a number of changes spread throughout GHC's code base), thus we fix #17465. Fixes #17646 on the go. Metric Decrease: T11822 T9233 PmSeriesS haddock.compiler - - - - - 86966d48 by Sebastian Graf at 2020-01-25T05:21:05-05:00 PmCheck: Properly handle constructor-bound type variables In https://gitlab.haskell.org/ghc/ghc/merge_requests/2192#note_246551 Simon convinced me that ignoring type variables existentially bound by data constructors have to be the same way as value binders. Sadly I couldn't think of a regression test, but I'm confident that this change strictly improves on the status quo. - - - - - c3fde723 by Ryan Scott at 2020-01-25T05:21:40-05:00 Handle local fixity declarations in DsMeta properly `DsMeta.rep_sig` used to skip over `FixSig` entirely, which had the effect of causing local fixity declarations to be dropped when quoted in Template Haskell. But there is no good reason for this state of affairs, as the code in `DsMeta.repFixD` (which handles top-level fixity declarations) handles local fixity declarations just fine. This patch factors out the necessary parts of `repFixD` so that they can be used in `rep_sig` as well. There was one minor complication: the fixity signatures for class methods in each `HsGroup` were stored both in `FixSig`s _and_ the list of `LFixitySig`s for top-level fixity signatures, so I needed to take action to prevent fixity signatures for class methods being converted to `Dec`s twice. I tweaked `RnSource.add` to avoid putting these fixity signatures in two places and added `Note [Top-level fixity signatures in an HsGroup]` in `GHC.Hs.Decls` to explain the new design. Fixes #17608. Bumps the Haddock submodule. - - - - - 6e2d9ee2 by Sylvain Henry at 2020-01-25T05:22:20-05:00 Module hierarchy: Cmm (cf #13009) - - - - - 8b726534 by PHO at 2020-01-25T05:23:01-05:00 Fix rts allocateExec() on NetBSD Similar to SELinux, NetBSD "PaX mprotect" prohibits marking a page mapping both writable and executable at the same time. Use libffi which knows how to work around it. - - - - - 6eb566a0 by Xavier Denis at 2020-01-25T05:23:39-05:00 Add ghc-in-ghci for stack based builds - - - - - b1a32170 by Xavier Denis at 2020-01-25T05:23:39-05:00 Create ghci.cabal.sh - - - - - 0a5e4f5f by Sylvain Henry at 2020-01-25T05:24:19-05:00 Split glasgow_exts into several files (#17316) - - - - - b3e5c678 by Ben Gamari at 2020-01-25T05:24:57-05:00 hadrian: Throw error on duplicate-named flavours Throw an error if the user requests a flavour for which there is more than one match. Fixes #17156. - - - - - 0940b59a by Ryan Scott at 2020-01-25T08:15:05-05:00 Do not bring visible foralls into scope in hsScopedTvs Previously, `hsScopedTvs` (and its cousin `hsWcScopedTvs`) pretended that visible dependent quantification could not possibly happen at the term level, and cemented that assumption with an `ASSERT`: ```hs hsScopedTvs (HsForAllTy { hst_fvf = vis_flag, ... }) = ASSERT( vis_flag == ForallInvis ) ... ``` It turns out that this assumption is wrong. You can end up tripping this `ASSERT` if you stick it to the man and write a type for a term that uses visible dependent quantification anyway, like in this example: ```hs {-# LANGUAGE ScopedTypeVariables #-} x :: forall a -> a -> a x = x ``` That won't typecheck, but that's not the point. Before the typechecker has a chance to reject this, the renamer will try to use `hsScopedTvs` to bring `a` into scope over the body of `x`, since `a` is quantified by a `forall`. This, in turn, causes the `ASSERT` to fail. Bummer. Instead of walking on this dangerous ground, this patch makes GHC adopt a more hardline stance by pattern-matching directly on `ForallInvis` in `hsScopedTvs`: ```hs hsScopedTvs (HsForAllTy { hst_fvf = ForallInvis, ... }) = ... ``` Now `a` will not be brought over the body of `x` at all (which is how it should be), there's no chance of the `ASSERT` failing anymore (as it's gone), and best of all, the behavior of `hsScopedTvs` does not change. Everyone wins! Fixes #17687. - - - - - 1132602f by Ryan Scott at 2020-01-27T10:03:42-05:00 Use splitLHs{ForAll,Sigma}TyInvis throughout the codebase Richard points out in #17688 that we use `splitLHsForAllTy` and `splitLHsSigmaTy` in places that we ought to be using the corresponding `-Invis` variants instead, identifying two bugs that are caused by this oversight: * Certain TH-quoted type signatures, such as those that appear in quoted `SPECIALISE` pragmas, silently turn visible `forall`s into invisible `forall`s. * When quoted, the type `forall a -> (a ~ a) => a` will turn into `forall a -> a` due to a bug in `DsMeta.repForall` that drops contexts that follow visible `forall`s. These are both ultimately caused by the fact that `splitLHsForAllTy` and `splitLHsSigmaTy` split apart visible `forall`s in addition to invisible ones. This patch cleans things up: * We now use `splitLHsForAllTyInvis` and `splitLHsSigmaTyInvis` throughout the codebase. Relatedly, the `splitLHsForAllTy` and `splitLHsSigmaTy` have been removed, as they are easy to misuse. * `DsMeta.repForall` now only handles invisible `forall`s to reduce the chance for confusion with visible `forall`s, which need to be handled differently. I also renamed it from `repForall` to `repForallT` to emphasize that its distinguishing characteristic is the fact that it desugars down to `L.H.TH.Syntax.ForallT`. Fixes #17688. - - - - - 97d0b0a3 by Matthew Pickering at 2020-01-27T10:04:19-05:00 Make Block.h compile with c++ compilers - - - - - 4bada77d by Tom Ellis at 2020-01-27T12:30:46-05:00 Disable two warnings for files that trigger them incomplete-uni-patterns and incomplete-record-updates will be in -Wall at a future date, so prepare for that by disabling those warnings on files that trigger them. - - - - - 0188404a by Tom Ellis at 2020-01-27T12:30:46-05:00 Add two warnings to stage 2 build - - - - - acae02c1 by Tom Ellis at 2020-01-27T12:30:46-05:00 Add two warnings to Hadrian - - - - - bf38a20e by Sylvain Henry at 2020-01-31T02:46:15-05:00 Call `interpretPackageEnv` from `setSessionDynFlags` interpretPackageEnv modifies the flags by reading the dreaded package environments. It is much less surprising to call it from `setSessionDynFlags` instead of reading package environments as a side-effect of `initPackages`. - - - - - 29c701c1 by Sylvain Henry at 2020-01-31T02:46:15-05:00 Refactor package related code The package terminology is a bit of a mess. Cabal packages contain components. Instances of these components when built with some flags/options/dependencies are called units. Units are registered into package databases and their metadata are called PackageConfig. GHC only knows about package databases containing units. It is a sad mismatch not fixed by this patch (we would have to rename parameters such as `package-id <unit-id>` which would affect users). This patch however fixes the following internal names: - Renames PackageConfig into UnitInfo. - Rename systemPackageConfig into globalPackageDatabase[Path] - Rename PkgConfXX into PkgDbXX - Rename pkgIdMap into unitIdMap - Rename ModuleToPkgDbAll into ModuleNameProvidersMap - Rename lookupPackage into lookupUnit - Add comments on DynFlags package related fields It also introduces a new `PackageDatabase` datatype instead of explicitly passing the following tuple: `(FilePath,[PackageConfig])`. The `pkgDatabase` field in `DynFlags` now contains the unit info for each unit of each package database exactly as they have been read from disk. Previously the command-line flag `-distrust-all-packages` would modify these unit info. Now this flag only affects the "dynamic" consolidated package state found in `pkgState` field. It makes sense because `initPackages` could be called first with this `distrust-all-packages` flag set and then again (using ghc-api) without and it should work (package databases are not read again from disk when `initPackages` is called the second time). Bump haddock submodule - - - - - 942c7148 by Ben Gamari at 2020-01-31T02:46:54-05:00 rename: Eliminate usage of mkVarOccUnique Replacing it with `newSysName`. Fixes #17061. - - - - - 41117d71 by Ben Gamari at 2020-01-31T02:47:31-05:00 base: Use one-shot kqueue on macOS The underlying reason requiring that one-shot usage be disabled (#13903) has been fixed. Closes #15768. - - - - - 01b15b83 by Ben Gamari at 2020-01-31T02:48:08-05:00 testsuite: Don't crash on encoding failure in print If the user doesn't use a Unicode locale then the testsuite driver would previously throw framework failures due to encoding failures. We now rather use the `replace` error-handling strategy. - - - - - c846618a by Ömer Sinan Ağacan at 2020-01-31T12:21:10+03:00 Do CafInfo/SRT analysis in Cmm This patch removes all CafInfo predictions and various hacks to preserve predicted CafInfos from the compiler and assigns final CafInfos to interface Ids after code generation. SRT analysis is extended to support static data, and Cmm generator is modified to allow generating static_link fields after SRT analysis. This also fixes `-fcatch-bottoms`, which introduces error calls in case expressions in CorePrep, which runs *after* CoreTidy (which is where we decide on CafInfos) and turns previously non-CAFFY things into CAFFY. Fixes #17648 Fixes #9718 Evaluation ========== NoFib ----- Boot with: `make boot mode=fast` Run: `make mode=fast EXTRA_RUNTEST_OPTS="-cachegrind" NoFibRuns=1` -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS -0.0% 0.0% -0.0% -0.0% -0.0% CSD -0.0% 0.0% -0.0% -0.0% -0.0% FS -0.0% 0.0% -0.0% -0.0% -0.0% S -0.0% 0.0% -0.0% -0.0% -0.0% VS -0.0% 0.0% -0.0% -0.0% -0.0% VSD -0.0% 0.0% -0.0% -0.0% -0.5% VSM -0.0% 0.0% -0.0% -0.0% -0.0% anna -0.1% 0.0% -0.0% -0.0% -0.0% ansi -0.0% 0.0% -0.0% -0.0% -0.0% atom -0.0% 0.0% -0.0% -0.0% -0.0% awards -0.0% 0.0% -0.0% -0.0% -0.0% banner -0.0% 0.0% -0.0% -0.0% -0.0% bernouilli -0.0% 0.0% -0.0% -0.0% -0.0% binary-trees -0.0% 0.0% -0.0% -0.0% -0.0% boyer -0.0% 0.0% -0.0% -0.0% -0.0% boyer2 -0.0% 0.0% -0.0% -0.0% -0.0% bspt -0.0% 0.0% -0.0% -0.0% -0.0% cacheprof -0.0% 0.0% -0.0% -0.0% -0.0% calendar -0.0% 0.0% -0.0% -0.0% -0.0% cichelli -0.0% 0.0% -0.0% -0.0% -0.0% circsim -0.0% 0.0% -0.0% -0.0% -0.0% clausify -0.0% 0.0% -0.0% -0.0% -0.0% comp_lab_zift -0.0% 0.0% -0.0% -0.0% -0.0% compress -0.0% 0.0% -0.0% -0.0% -0.0% compress2 -0.0% 0.0% -0.0% -0.0% -0.0% constraints -0.0% 0.0% -0.0% -0.0% -0.0% cryptarithm1 -0.0% 0.0% -0.0% -0.0% -0.0% cryptarithm2 -0.0% 0.0% -0.0% -0.0% -0.0% cse -0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 -0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 -0.0% 0.0% -0.0% -0.0% -0.0% dom-lt -0.0% 0.0% -0.0% -0.0% -0.0% eliza -0.0% 0.0% -0.0% -0.0% -0.0% event -0.0% 0.0% -0.0% -0.0% -0.0% exact-reals -0.0% 0.0% -0.0% -0.0% -0.0% exp3_8 -0.0% 0.0% -0.0% -0.0% -0.0% expert -0.0% 0.0% -0.0% -0.0% -0.0% fannkuch-redux -0.0% 0.0% -0.0% -0.0% -0.0% fasta -0.0% 0.0% -0.0% -0.0% -0.0% fem -0.0% 0.0% -0.0% -0.0% -0.0% fft -0.0% 0.0% -0.0% -0.0% -0.0% fft2 -0.0% 0.0% -0.0% -0.0% -0.0% fibheaps -0.0% 0.0% -0.0% -0.0% -0.0% fish -0.0% 0.0% -0.0% -0.0% -0.0% fluid -0.1% 0.0% -0.0% -0.0% -0.0% fulsom -0.0% 0.0% -0.0% -0.0% -0.0% gamteb -0.0% 0.0% -0.0% -0.0% -0.0% gcd -0.0% 0.0% -0.0% -0.0% -0.0% gen_regexps -0.0% 0.0% -0.0% -0.0% -0.0% genfft -0.0% 0.0% -0.0% -0.0% -0.0% gg -0.0% 0.0% -0.0% -0.0% -0.0% grep -0.0% 0.0% -0.0% -0.0% -0.0% hidden -0.0% 0.0% -0.0% -0.0% -0.0% hpg -0.1% 0.0% -0.0% -0.0% -0.0% ida -0.0% 0.0% -0.0% -0.0% -0.0% infer -0.0% 0.0% -0.0% -0.0% -0.0% integer -0.0% 0.0% -0.0% -0.0% -0.0% integrate -0.0% 0.0% -0.0% -0.0% -0.0% k-nucleotide -0.0% 0.0% -0.0% -0.0% -0.0% kahan -0.0% 0.0% -0.0% -0.0% -0.0% knights -0.0% 0.0% -0.0% -0.0% -0.0% lambda -0.0% 0.0% -0.0% -0.0% -0.0% last-piece -0.0% 0.0% -0.0% -0.0% -0.0% lcss -0.0% 0.0% -0.0% -0.0% -0.0% life -0.0% 0.0% -0.0% -0.0% -0.0% lift -0.0% 0.0% -0.0% -0.0% -0.0% linear -0.1% 0.0% -0.0% -0.0% -0.0% listcompr -0.0% 0.0% -0.0% -0.0% -0.0% listcopy -0.0% 0.0% -0.0% -0.0% -0.0% maillist -0.0% 0.0% -0.0% -0.0% -0.0% mandel -0.0% 0.0% -0.0% -0.0% -0.0% mandel2 -0.0% 0.0% -0.0% -0.0% -0.0% mate -0.0% 0.0% -0.0% -0.0% -0.0% minimax -0.0% 0.0% -0.0% -0.0% -0.0% mkhprog -0.0% 0.0% -0.0% -0.0% -0.0% multiplier -0.0% 0.0% -0.0% -0.0% -0.0% n-body -0.0% 0.0% -0.0% -0.0% -0.0% nucleic2 -0.0% 0.0% -0.0% -0.0% -0.0% para -0.0% 0.0% -0.0% -0.0% -0.0% paraffins -0.0% 0.0% -0.0% -0.0% -0.0% parser -0.1% 0.0% -0.0% -0.0% -0.0% parstof -0.1% 0.0% -0.0% -0.0% -0.0% pic -0.0% 0.0% -0.0% -0.0% -0.0% pidigits -0.0% 0.0% -0.0% -0.0% -0.0% power -0.0% 0.0% -0.0% -0.0% -0.0% pretty -0.0% 0.0% -0.3% -0.4% -0.4% primes -0.0% 0.0% -0.0% -0.0% -0.0% primetest -0.0% 0.0% -0.0% -0.0% -0.0% prolog -0.0% 0.0% -0.0% -0.0% -0.0% puzzle -0.0% 0.0% -0.0% -0.0% -0.0% queens -0.0% 0.0% -0.0% -0.0% -0.0% reptile -0.0% 0.0% -0.0% -0.0% -0.0% reverse-complem -0.0% 0.0% -0.0% -0.0% -0.0% rewrite -0.0% 0.0% -0.0% -0.0% -0.0% rfib -0.0% 0.0% -0.0% -0.0% -0.0% rsa -0.0% 0.0% -0.0% -0.0% -0.0% scc -0.0% 0.0% -0.3% -0.5% -0.4% sched -0.0% 0.0% -0.0% -0.0% -0.0% scs -0.0% 0.0% -0.0% -0.0% -0.0% simple -0.1% 0.0% -0.0% -0.0% -0.0% solid -0.0% 0.0% -0.0% -0.0% -0.0% sorting -0.0% 0.0% -0.0% -0.0% -0.0% spectral-norm -0.0% 0.0% -0.0% -0.0% -0.0% sphere -0.0% 0.0% -0.0% -0.0% -0.0% symalg -0.0% 0.0% -0.0% -0.0% -0.0% tak -0.0% 0.0% -0.0% -0.0% -0.0% transform -0.0% 0.0% -0.0% -0.0% -0.0% treejoin -0.0% 0.0% -0.0% -0.0% -0.0% typecheck -0.0% 0.0% -0.0% -0.0% -0.0% veritas -0.0% 0.0% -0.0% -0.0% -0.0% wang -0.0% 0.0% -0.0% -0.0% -0.0% wave4main -0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 -0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 -0.0% 0.0% -0.0% -0.0% -0.0% x2n1 -0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min -0.1% 0.0% -0.3% -0.5% -0.5% Max -0.0% 0.0% -0.0% -0.0% -0.0% Geometric Mean -0.0% -0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- circsim -0.1% 0.0% -0.0% -0.0% -0.0% constraints -0.0% 0.0% -0.0% -0.0% -0.0% fibheaps -0.0% 0.0% -0.0% -0.0% -0.0% gc_bench -0.0% 0.0% -0.0% -0.0% -0.0% hash -0.0% 0.0% -0.0% -0.0% -0.0% lcss -0.0% 0.0% -0.0% -0.0% -0.0% power -0.0% 0.0% -0.0% -0.0% -0.0% spellcheck -0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min -0.1% 0.0% -0.0% -0.0% -0.0% Max -0.0% 0.0% -0.0% -0.0% -0.0% Geometric Mean -0.0% +0.0% -0.0% -0.0% -0.0% Manual inspection of programs in testsuite/tests/programs --------------------------------------------------------- I built these programs with a bunch of dump flags and `-O` and compared STG, Cmm, and Asm dumps and file sizes. (Below the numbers in parenthesis show number of modules in the program) These programs have identical compiler (same .hi and .o sizes, STG, and Cmm and Asm dumps): - Queens (1), andre_monad (1), cholewo-eval (2), cvh_unboxing (3), andy_cherry (7), fun_insts (1), hs-boot (4), fast2haskell (2), jl_defaults (1), jq_readsPrec (1), jules_xref (1), jtod_circint (4), jules_xref2 (1), lennart_range (1), lex (1), life_space_leak (1), bargon-mangler-bug (7), record_upd (1), rittri (1), sanders_array (1), strict_anns (1), thurston-module-arith (2), okeefe_neural (1), joao-circular (6), 10queens (1) Programs with different compiler outputs: - jl_defaults (1): For some reason GHC HEAD marks a lot of top-level `[Int]` closures as CAFFY for no reason. With this patch we no longer make them CAFFY and generate less SRT entries. For some reason Main.o is slightly larger with this patch (1.3%) and the executable sizes are the same. (I'd expect both to be smaller) - launchbury (1): Same as jl_defaults: top-level `[Int]` closures marked as CAFFY for no reason. Similarly `Main.o` is 1.4% larger but the executable sizes are the same. - galois_raytrace (13): Differences are in the Parse module. There are a lot, but some of the changes are caused by the fact that for some reason (I think a bug) GHC HEAD marks the dictionary for `Functor Identity` as CAFFY. Parse.o is 0.4% larger, the executable size is the same. - north_array: We now generate less SRT entries because some of array primops used in this program like `NewArrayOp` get eliminated during Stg-to-Cmm and turn some CAFFY things into non-CAFFY. Main.o gets 24% larger (9224 bytes from 9000 bytes), executable sizes are the same. - seward-space-leak: Difference in this program is better shown by this smaller example: module Lib where data CDS = Case [CDS] [(Int, CDS)] | Call CDS CDS instance Eq CDS where Case sels1 rets1 == Case sels2 rets2 = sels1 == sels2 && rets1 == rets2 Call a1 b1 == Call a2 b2 = a1 == a2 && b1 == b2 _ == _ = False In this program GHC HEAD builds a new SRT for the recursive group of `(==)`, `(/=)` and the dictionary closure. Then `/=` points to `==` in its SRT field, and `==` uses the SRT object as its SRT. With this patch we use the closure for `/=` as the SRT and add `==` there. Then `/=` gets an empty SRT field and `==` points to `/=` in its SRT field. This change looks fine to me. Main.o gets 0.07% larger, executable sizes are identical. head.hackage ------------ head.hackage's CI script builds 428 packages from Hackage using this patch with no failures. Compiler performance -------------------- The compiler perf tests report that the compiler allocates slightly more (worst case observed so far is 4%). However most programs in the test suite are small, single file programs. To benchmark compiler performance on something more realistic I build Cabal (the library, 236 modules) with different optimisation levels. For the "max residency" row I run GHC with `+RTS -s -A100k -i0 -h` for more accurate numbers. Other rows are generated with just `-s`. (This is because `-i0` causes running GC much more frequently and as a result "bytes copied" gets inflated by more than 25x in some cases) * -O0 | | GHC HEAD | This MR | Diff | | --------------- | -------------- | -------------- | ------ | | Bytes allocated | 54,413,350,872 | 54,701,099,464 | +0.52% | | Bytes copied | 4,926,037,184 | 4,990,638,760 | +1.31% | | Max residency | 421,225,624 | 424,324,264 | +0.73% | * -O1 | | GHC HEAD | This MR | Diff | | --------------- | --------------- | --------------- | ------ | | Bytes allocated | 245,849,209,992 | 246,562,088,672 | +0.28% | | Bytes copied | 26,943,452,560 | 27,089,972,296 | +0.54% | | Max residency | 982,643,440 | 991,663,432 | +0.91% | * -O2 | | GHC HEAD | This MR | Diff | | --------------- | --------------- | --------------- | ------ | | Bytes allocated | 291,044,511,408 | 291,863,910,912 | +0.28% | | Bytes copied | 37,044,237,616 | 36,121,690,472 | -2.49% | | Max residency | 1,071,600,328 | 1,086,396,256 | +1.38% | Extra compiler allocations -------------------------- Runtime allocations of programs are as reported above (NoFib section). The compiler now allocates more than before. Main source of allocation in this patch compared to base commit is the new SRT algorithm (GHC.Cmm.Info.Build). Below is some of the extra work we do with this patch, numbers generated by profiled stage 2 compiler when building a pathological case (the test 'ManyConstructors') with '-O2': - We now sort the final STG for a module, which means traversing the entire program, generating free variable set for each top-level binding, doing SCC analysis, and re-ordering the program. In ManyConstructors this step allocates 97,889,952 bytes. - We now do SRT analysis on static data, which in a program like ManyConstructors causes analysing 10,000 bindings that we would previously just skip. This step allocates 70,898,352 bytes. - We now maintain an SRT map for the entire module as we compile Cmm groups: data ModuleSRTInfo = ModuleSRTInfo { ... , moduleSRTMap :: SRTMap } (SRTMap is just a strict Map from the 'containers' library) This map gets an entry for most bindings in a module (exceptions are THUNKs and CAFFY static functions). For ManyConstructors this map gets 50015 entries. - Once we're done with code generation we generate a NameSet from SRTMap for the non-CAFFY names in the current module. This set gets the same number of entries as the SRTMap. - Finally we update CafInfos in ModDetails for the non-CAFFY Ids, using the NameSet generated in the previous step. This usually does the least amount of allocation among the work listed here. Only place with this patch where we do less work in the CAF analysis in the tidying pass (CoreTidy). However that doesn't save us much, as the pass still needs to traverse the whole program and update IdInfos for other reasons. Only thing we don't here do is the `hasCafRefs` pass over the RHS of bindings, which is a stateless pass that returns a boolean value, so it doesn't allocate much. (Metric changes blow are all increased allocations) Metric changes -------------- Metric Increase: ManyAlternatives ManyConstructors T13035 T14683 T1969 T9961 - - - - - 2a87a565 by Andreas Klebinger at 2020-01-31T12:21:10+03:00 A few optimizations in STG and Cmm parts: (Guided by the profiler output) - Add a few bang patterns, INLINABLE annotations, and a seqList in a few places in Cmm and STG parts. - Do not add external variables as dependencies in STG dependency analysis (GHC.Stg.DepAnal). - - - - - bef704b6 by Simon Peyton Jones at 2020-02-01T02:28:45-05:00 Improve skolemisation This patch avoids skolemiseUnboundMetaTyVar making up a fresh Name when it doesn't need to. See Note [Skolemising and identity] Improves error messsages for partial type signatures. - - - - - cd110423 by Simon Peyton Jones at 2020-02-01T02:28:45-05:00 Improve pretty-printing for TyConBinders In particular, show their kinds. - - - - - 913287a0 by Simon Peyton Jones at 2020-02-01T02:28:45-05:00 Fix scoping of TyCon binders in TcTyClsDecls This patch fixes #17566 by refactoring the way we decide the final identity of the tyvars in the TyCons of a possibly-recursive nest of type and class decls, possibly with associated types. It's all laid out in Note [Swizzling the tyvars before generaliseTcTyCon] Main changes: * We have to generalise each decl (with its associated types) all at once: TcTyClsDecls.generaliseTyClDecl * The main new work is done in TcTyClsDecls.swizzleTcTyConBndrs * The mysterious TcHsSyn.zonkRecTyVarBndrs dies altogether Other smaller things: * A little refactoring, moving bindTyClTyVars from tcTyClDecl1 to tcDataDefn, tcSynRhs, etc. Clearer, reduces the number of parameters * Reduce the amount of swizzling required. Specifically, bindExplicitTKBndrs_Q_Tv doesn't need to clone a new Name for the TyVarTv, and not cloning means that in the vasly common case, swizzleTyConBndrs is a no-op In detail: Rename newTyVarTyVar --> cloneTyVarTyVar Add newTyVarTyTyVar that doesn't clone Use the non-cloning newTyVarTyVar in bindExplicitTKBndrs_Q_Tv Rename newFlexiKindedTyVarTyVar --> cloneFlexiKindedTyVarTyVar * Define new utility function and use it HsDecls.familyDeclName :: FamilyDecl (GhcPass p) -> IdP (GhcPass p) Updates haddock submodule. - - - - - 58ed6c4a by Ben Gamari at 2020-02-01T02:29:23-05:00 rts/M32Alloc: Don't attempt to unmap non-existent pages The m32 allocator's `pages` list may contain NULLs in the case that the page was flushed. Some `munmap` implementations (e.g. FreeBSD's) don't like it if we pass them NULL. Don't do that. - - - - - 859db7d6 by Ömer Sinan Ağacan at 2020-02-01T14:18:49+03:00 Improve/fix -fcatch-bottoms documentation Old documentation suggests that -fcatch-bottoms only adds a default alternative to bottoming case expression, but that's not true. We use a very simplistic "is exhaustive" check and add default alternatives to any case expression that does not cover all constructors of the type. In case of GADTs this simple check assumes all constructors should be covered, even the ones ruled out by the type of the scrutinee. Update the documentation to reflect this. (Originally noticed in #17648) [ci skip] - - - - - 54dfa94a by John Ericson at 2020-02-03T21:14:24-05:00 Fix docs for FrontendResult Other variant was removed in ac1a379363618a6f2f17fff65ce9129164b6ef30 but docs were no changed. - - - - - 5e63d9c0 by John Ericson at 2020-02-03T21:15:02-05:00 Refactor HscMain.finish I found the old control flow a bit hard to follow; I rewrote it to first decide whether to desugar, and then use that choice when computing whether to simplify / what sort of interface file to write. I hope eventually we will always write post-tc interface files, which will make the logic of this function even simpler, and continue the thrust of this refactor. - - - - - e580e5b8 by Stefan Schulze Frielinghaus at 2020-02-04T09:29:00-05:00 Do not build StgCRunAsm.S for unregisterised builds For unregisterised builds StgRun/StgReturn are implemented via a mini interpreter in StgCRun.c and therefore would collide with the implementations in StgCRunAsm.S. - - - - - e3b0bd97 by Stefan Schulze Frielinghaus at 2020-02-04T09:29:00-05:00 fixup! fixup! Do not build StgCRunAsm.S for unregisterised builds - - - - - eb629fab by John Ericson at 2020-02-04T09:29:38-05:00 Delete some superfluous helper functions in HscMain The driver code is some of the nastiest in GHC, and I am worried about being able to untangle all the tech debt. In `HscMain` we have a number of helpers which are either not-used or little used. I delete them so we can reduce cognative load, distilling the essential complexity away from the cruft. - - - - - c90eca55 by Sebastian Graf at 2020-02-05T09:21:29-05:00 PmCheck: Record type constraints arising from existentials in `PmCoreCt`s In #17703 (a follow-up of !2192), we established that contrary to my belief, type constraints arising from existentials in code like ```hs data Ex where Ex :: a -> Ex f _ | let x = Ex @Int 15 = case x of Ex -> ... ``` are in fact useful. This commit makes a number of refactorings and improvements to comments, but fundamentally changes `addCoreCt.core_expr` to record the type constraint `a ~ Int` in addition to `x ~ Ex @a y` and `y ~ 15`. Fixes #17703. - - - - - 6d3b5d57 by Ömer Sinan Ağacan at 2020-02-05T09:22:10-05:00 testlib: Extend existing *_opts in extra_*_opts Previously we'd override the existing {run,hc} opts in extra_{run,hc}_opts, which caused flakiness in T1969, see #17712. extra_{run,hc}_opts now extends {run,hc} opts, instead of overriding. Also we shrank the allocation area for T1969 in order to increase residency sampling frequency. Fixes #17712 - - - - - 9c89a48d by Ömer Sinan Ağacan at 2020-02-05T09:22:52-05:00 Remove CafInfo-related code from STG lambda lift pass After c846618ae0 we don't have accurate CafInfos for Ids in the current module and we're free to introduce new CAFFY or non-CAFFY bindings or change CafInfos of existing binders; so no we no longer need to maintain CafInfos in Core or STG passes. - - - - - 70ddb8bf by Ryan Scott at 2020-02-05T09:23:30-05:00 Add regression test for #17773 - - - - - e8004e5d by Ben Gamari at 2020-02-05T13:55:19-05:00 gitlab-ci: Allow Windows builds to fail again Due to T7702 and the process issues described in #17777. - - - - - 29b72c00 by Ben Gamari at 2020-02-06T11:55:41-05:00 VarSet: Introduce nonDetFoldVarSet - - - - - c4e6b35d by Ben Gamari at 2020-02-06T11:55:41-05:00 Move closeOverKinds and friends to TyCoFVs - - - - - ed2f0e5c by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Reform the free variable finders for types This patch delivers on (much of) #17509. * Introduces the shallow vs deep free variable distinction * Introduce TyCoRep.foldType, foldType :: Monoid a => TyCoFolder env a -> env -> Type -> a and use it in the free variable finders. * Substitution in TyCoSubst * ASSERTs are on for checkValidSubst * checkValidSubst uses shallowTyCoVarsOfTypes etc Quite a few things still to do * We could use foldType in lots of other places * We could use mapType for substitution. (Check that we get good code!) * Some (but not yet all) clients of substitution can now save time by using shallowTyCoVarsOfTypes * All calls to tyCoVarsOfTypes should be inspected; most of them should be shallow. Maybe. * Currently shallowTyCoVarsOfTypes still returns unification variables, but not CoVarHoles. Reason: we need to return unification variables in some of the calls in TcSimplify, eg when promoting. * We should do the same thing for tyCoFVsOfTypes, which is currently unchanged. * tyCoFVsOfTypes returns CoVarHoles, because of the use in TcSimplify.mkResidualConstraints. See Note [Emitting the residual implication in simplifyInfer] * #17509 talks about "relevant" variables too. - - - - - 01a1f4fb by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Use foldTyCo for noFreeVarsOfType - - - - - 0e59afd6 by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Simplify closeOverKinds - - - - - 9ca5c88e by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Use foldTyCo for coVarsOfType - - - - - 5541b87c by Simon Peyton Jones at 2020-02-06T11:55:41-05:00 Use foldTyCo for exactTyCoVarsOfType This entailed * Adding a tcf_view field to TyCoFolder * Moving exactTyCoVarsOtType to TcType. It properly belongs there, since only the typechecker calls this function. But it also means that we can "see" and inline tcView. Metric Decrease: T14683 - - - - - 7c122851 by Simon Peyton Jones at 2020-02-06T11:56:02-05:00 Comments only - - - - - 588acb99 by Adam Sandberg Eriksson at 2020-02-08T10:15:38-05:00 slightly better named cost-centres for simple pattern bindings #17006 ``` main = do print $ g [1..100] a where g xs x = map (`mod` x) xs a :: Int = 324 ``` The above program previously attributed the cost of computing 324 to a cost centre named `(...)`, with this change the cost is attributed to `a` instead. This change only affects simple pattern bindings (decorated variables: type signatures, parens, ~ annotations and ! annotations). - - - - - 309f8cfd by Richard Eisenberg at 2020-02-08T10:16:33-05:00 Remove unnecessary parentheses - - - - - 7755ffc2 by Richard Eisenberg at 2020-02-08T10:16:33-05:00 Introduce IsPass; refactor wrappers. There are two main payloads of this patch: 1. This introduces IsPass, which allows e.g. printing code to ask what pass it is running in (Renamed vs Typechecked) and thus print extension fields. See Note [IsPass] in Hs.Extension 2. This moves the HsWrap constructor into an extension field, where it rightly belongs. This is done for HsExpr and HsCmd, but not for HsPat, which is left as an exercise for the reader. There is also some refactoring around SyntaxExprs, but this is really just incidental. This patch subsumes !1721 (sorry @chreekat). Along the way, there is a bit of refactoring in GHC.Hs.Extension, including the removal of NameOrRdrName in favor of NoGhcTc. This meant that we had no real need for GHC.Hs.PlaceHolder, so I got rid of it. Updates haddock submodule. ------------------------- Metric Decrease: haddock.compiler ------------------------- - - - - - 7d452be4 by Dylan Yudaken at 2020-02-08T10:17:17-05:00 Fix hs_try_putmvar losing track of running cap If hs_try_putmvar was called through an unsafe import, it would lose track of the running cap causing a deadlock - - - - - c2e301ae by Ben Gamari at 2020-02-08T10:17:55-05:00 compiler: Qualify imports of Data.List - - - - - aede171a by Ben Gamari at 2020-02-08T10:17:55-05:00 testsuite: Fix -Wcompat-unqualified-imports issues - - - - - 4435a8e0 by Ben Gamari at 2020-02-08T10:17:55-05:00 Introduce -Wcompat-unqualified-imports This implements the warning proposed in option (B) of the Data.List.singleton CLC [discussion][]. This warning, which is included in `-Wcompat` is intended to help users identify imports of modules that will change incompatibly in future GHC releases. This currently only includes `Data.List` due to the expected specialisation and addition of `Data.List.singleton`. Fixes #17244. [discussion]: https://groups.google.com/d/msg/haskell-core-libraries/q3zHLmzBa5E/PmlAs_kYAQAJ - - - - - 28b5349a by Ben Gamari at 2020-02-08T10:17:55-05:00 Bump stm and process submodules - - - - - 7d04b9f2 by Ben Gamari at 2020-02-08T10:18:31-05:00 hadrian: Allow override of Cabal configuration in hadrian.settings Fixes #17612 by adding a `cabal.configure.opts` key for `hadrian.settings`. - - - - - 88bf81aa by Andreas Klebinger at 2020-02-08T10:19:10-05:00 Optimize unpackCString# to allocate less. unpackCString# is a recursive function which for each iteration returns a Cons cell containing the current Char, and a thunk for unpacking the rest of the string. In this patch we change from storing addr + offset inside this thunk to storing only the addr, simply incrementing the address on each iteration. This saves one word of allocation per unpacked character. For a program like "main = print "<largishString>" this amounts to 2-3% fewer % in bytes allocated. I also removed the now redundant local unpack definitions. This removes one call per unpack operation. - - - - - bec76733 by Ben Gamari at 2020-02-08T10:19:57-05:00 Fix GhcThreaded setting This adopts a patch from NetBSD's packaging fixing the `GhcThreaded` option of the make build system. In addition we introduce a `ghcThreaded` option in hadrian's `Flavour` type. Also fix Hadrian's treatment of the `Use Threaded` entry in `settings`. Previously it would incorrectly claim `Use Threaded = True` if we were building the `threaded` runtime way. However, this is inconsistent with the `make` build system, which defines it to be whether the `ghc` executable is linked against the threaded runtime. Fixes #17692. - - - - - 545cf1e1 by Ben Gamari at 2020-02-08T10:20:37-05:00 hadrian: Depend upon libray dependencies when configuring packages This will hopefully fix #17631. - - - - - 047d3d75 by Ben Gamari at 2020-02-08T10:21:16-05:00 testsuite: Add test for #15316 This is the full testcase for T15316. - - - - - 768e5866 by Julien Debon at 2020-02-08T10:22:07-05:00 doc(Data.List): Add some examples to Data.List - - - - - 3900cb83 by Julien Debon at 2020-02-08T10:22:07-05:00 Apply suggestion to libraries/base/GHC/List.hs - - - - - bd666766 by Ben Gamari at 2020-02-08T10:22:45-05:00 users-guide: Clarify that bundled patsyns were introduced in GHC 8.0 Closes #17094. - - - - - 95741ea1 by Pepe Iborra at 2020-02-08T10:23:23-05:00 Update to hie-bios 0.3.2 style program cradle - - - - - fb5c1912 by Sylvain Henry at 2020-02-08T10:24:07-05:00 Remove redundant case This alternative is redundant and triggers no warning when building with 8.6.5 - - - - - 5d83d948 by Matthew Pickering at 2020-02-08T10:24:43-05:00 Add mkHieFileWithSource which doesn't read the source file from disk cc/ @pepeiborra - - - - - dfdae56d by Andreas Klebinger at 2020-02-08T10:25:20-05:00 Rename ghcAssert to stgAssert in hp2ps/Main.h. This fixes #17763 - - - - - 658f7ac6 by Ben Gamari at 2020-02-08T10:26:00-05:00 includes: Avoid using single-line comments in HsFFI.h While single-line comments are supported by C99, dtrace on SmartOS apparently doesn't support them yet. - - - - - c95920a6 by Ömer Sinan Ağacan at 2020-02-08T10:26:42-05:00 Import qualified Prelude in parser This is in preparation of backwards-incompatible changes in happy. See https://github.com/simonmar/happy/issues/166 - - - - - b6dc319a by Ömer Sinan Ağacan at 2020-02-08T10:27:23-05:00 Add regression test for #12760 The bug seems to be fixed in the meantime, make sure it stays fixed. Closes #12760 - - - - - b3857b62 by Ben Gamari at 2020-02-08T10:28:03-05:00 base: Drop out-of-date comment The comment in GHC.Base claimed that ($) couldn't be used in that module as it was wired-in. However, this is no longer true; ($) is merely known key and is defined in Haskell (with a RuntimeRep-polymorphic type) in GHC.Base. The one piece of magic that ($) retains is that it a special typing rule to allow type inference with higher-rank types (e.g. `runST $ blah`; see Note [Typing rule for ($)] in TcExpr). - - - - - 1183ae94 by Daniel Gröber at 2020-02-08T10:29:00-05:00 rts: Fix Arena blocks accounting for MBlock sized allocations When requesting more than BLOCKS_PER_MBLOCK blocks allocGroup can return a different number of blocks than requested. Here we use the number of requested blocks, however arenaFree will subtract the actual number of blocks we got from arena_blocks (possibly) resulting in a negative value and triggering ASSERT(arena_blocks >= 0). - - - - - 97d59db5 by Daniel Gröber at 2020-02-08T10:29:48-05:00 rts: Fix need_prealloc being reset when retainer profiling is on - - - - - 1f630025 by Krzysztof Gogolewski at 2020-02-09T02:52:27-05:00 Add a test for #15712 - - - - - 2ac784ab by Ben Gamari at 2020-02-09T02:53:05-05:00 hadrian: Add --test-metrics argument Allowing the test metric output to be captured to a file, a la the METRIC_FILE environment variable of the make build system. - - - - - f432d8c6 by Ben Gamari at 2020-02-09T02:53:05-05:00 hadrian: Fix --test-summary argument This appears to be a cut-and-paste error. - - - - - a906595f by Arnaud Spiwack at 2020-02-09T02:53:50-05:00 Fix an outdated note link This link appears to have been forgotten in 0dad81ca5fd1f63bf8a3b6ad09787559e8bd05c0 . - - - - - 3ae83da1 by Alp Mestanogullari at 2020-02-09T02:54:28-05:00 hadrian: Windows fixes (bindists, CI) This commit implements a few Windows-specific fixes which get us from a CI job that can't even get as far as starting the testsuite driver, to a state where we can run the entire testssuite (but have test failures to fix). - Don't forget about a potential extension for the haddock program, when preparing the bindist. - Build the timeout program, used by the testsuite driver on Windows in place of the Python script used elsewhere, using the boot compiler. We could alternatively build it with the compiler that we're going to test but this would be a lot more tedious to write. - Implement a wrapper-script less installation procedure for Windows, in `hadrian/bindist/Makefile. - Make dependencies a bit more accurate in the aforementioned Makefile. - Update Windows/Hadrian CI job accordingly. This patch fixes #17486. - - - - - 82f9be8c by Roland Senn at 2020-02-09T02:55:06-05:00 Fix #14628: Panic (No skolem Info) in GHCi This patch implements the [sugggestion from Simon (PJ)](https://gitlab.haskell.org/ghc/ghc/issues/14628#note_146559): - Make `TcErrors.getSkolemInfo` return a `SkolemInfo` rather than an `Implication`. - If `getSkolemInfo` gets `RuntimeUnk`s, just return a new data constructor in `SkolemInfo`, called `RuntimeUnkSkol`. - In `TcErrors.pprSkols` print something sensible for a `RuntimeUnkSkol`. The `getSkolemInfo` function paniced while formating suggestions to add type annotations (subfunction `suggestAddSig`) to a *"Couldn't match type ‘x’ with ‘y’"* error message. The `getSkolemInfo` function didn't find any Implication value and paniced. With this patch the `getSkolemInfo` function does no longer panic, if it finds `RuntimeUnkSkol`s. As the panic occured while processing an error message, we don't need to implement any new error message! - - - - - b2e18e26 by Andreas Klebinger at 2020-02-09T02:55:46-05:00 Fix -ddump-stg-final. Once again make sure this dumps the STG used for codegen. - - - - - 414e2f62 by Sylvain Henry at 2020-02-09T02:56:26-05:00 Force -fPIC for intree GMP (fix #17799) Configure intree GMP with `--with-pic` instead of patching it. Moreover the correct patching was only done for x86_64/darwin (see #17799). - - - - - f0fd72ee by Sebastian Graf at 2020-02-09T17:22:38-05:00 8.10 Release notes for improvements to the pattern-match checker [skip ci] A little late to the game, but better late than never. - - - - - 00dc0f7e by Ömer Sinan Ağacan at 2020-02-09T17:23:17-05:00 Add regression test for #13142 Closes #13142 - - - - - f3e737bb by Sebastian Graf at 2020-02-10T20:04:09-05:00 Fix long distance info for record updates For record updates where the `record_expr` is a variable, as in #17783: ```hs data PartialRec = No | Yes { a :: Int, b :: Bool } update No = No update r@(Yes {}) = r { b = False } ``` We should make use of long distance info in `-Wincomplete-record-updates` checking. But the call to `matchWrapper` in the `RecUpd` case didn't specify a scrutinee expression, which would correspond to the `record_expr` `r` here. That is fixed now. Fixes #17783. - - - - - 5670881d by Tamar Christina at 2020-02-10T20:05:04-05:00 Fs: Fix UNC remapping code. - - - - - 375b3c45 by Oleg Grenrus at 2020-02-11T05:07:30-05:00 Add singleton to Data.OldList - - - - - de32beff by Richard Eisenberg at 2020-02-11T05:08:10-05:00 Do not create nested quantified constraints Previously, we would accidentally make constraints like forall a. C a => forall b. D b => E a b c as we traversed superclasses. No longer! This patch also expands Note [Eagerly expand given superclasses] to work over quantified constraints; necessary for T16502b. Close #17202 and #16502. test cases: typecheck/should_compile/T{17202,16502{,b}} - - - - - e319570e by Ben Gamari at 2020-02-11T05:08:47-05:00 rts: Use nanosleep instead of usleep usleep was removed in POSIX.1-2008. - - - - - b75e7486 by Ben Gamari at 2020-02-11T05:09:24-05:00 rts: Remove incorrect assertions around MSG_THROWTO messages Previously we would assert that threads which are sending a `MSG_THROWTO` message must have their blocking status be blocked on the message. In the usual case of a thread throwing to another thread this is guaranteed by `stg_killThreadzh`. However, `throwToSelf`, used by the GC to kill threads which ran out of heap, failed to guarantee this. Noted while debugging #17785. - - - - - aba51b65 by Sylvain Henry at 2020-02-11T05:10:04-05:00 Add arithmetic exception primops (#14664) - - - - - b157399f by Ben Gamari at 2020-02-11T05:10:40-05:00 configure: Don't assume Gnu linker on Solaris Compl Yue noticed that the linker was dumping the link map on SmartOS. This is because Smartos uses the Solaris linker, which uses the `-64` flag, not `-m64` like Gnu ld, to indicate that it should link for 64-bits. Fix the configure script to handle the Solaris linker correctly. - - - - - d8d73d77 by Simon Peyton Jones at 2020-02-11T05:11:18-05:00 Notes only: telescopes This documentation-only patch fixes #17793 - - - - - 58a4ddef by Alp Mestanogullari at 2020-02-11T05:12:17-05:00 hadrian: build (and ship) iserv on Windows - - - - - 82023524 by Matthew Pickering at 2020-02-11T18:04:17-05:00 TemplateHaskellQuotes: Allow nested splices There is no issue with nested splices as they do not require any compile time code execution. All execution is delayed until the top-level splice. - - - - - 50e24edd by Ömer Sinan Ağacan at 2020-02-11T18:04:57-05:00 Remove Hadrian's copy of (Data.Functor.<&>) The function was added to base with base-4.11 (GHC 8.4) - - - - - f82a2f90 by Sylvain Henry at 2020-02-12T01:56:46-05:00 Document GMP build [skip ci] - - - - - da7f7479 by Sylvain Henry at 2020-02-12T01:57:27-05:00 Module hierarchy: ByteCode and Runtime (cf #13009) Update haddock submodule - - - - - 04f51297 by Ömer Sinan Ağacan at 2020-02-12T01:58:11-05:00 Fix naming of tests for #12923 - - - - - 31fc3321 by Ömer Sinan Ağacan at 2020-02-12T01:58:11-05:00 Add regression test for #12926 Closes #12926 - - - - - f0c0ee7d by Krzysztof Gogolewski at 2020-02-12T01:58:51-05:00 Fix order of arguments in specializer (#17801) See https://gitlab.haskell.org/ghc/ghc/issues/17801#note_253330 No regression test, as it's hard to trigger. - - - - - 059c3c9d by Sebastian Graf at 2020-02-12T11:00:58+01:00 Separate CPR analysis from the Demand analyser The reasons for that can be found in the wiki: https://gitlab.haskell.org/ghc/ghc/wikis/nested-cpr/split-off-cpr We now run CPR after demand analysis (except for after the final demand analysis run just before code gen). CPR got its own dump flags (`-ddump-cpr-anal`, `-ddump-cpr-signatures`), but not its own flag to activate/deactivate. It will run with `-fstrictness`/`-fworker-wrapper`. As explained on the wiki page, this step is necessary for a sane Nested CPR analysis. And it has quite positive impact on compiler performance: Metric Decrease: T9233 T9675 T9961 T15263 - - - - - f5ffd8d9 by Ben Gamari at 2020-02-12T17:22:37-05:00 base: Expose GHC.Unicode.unicodeVersion This exposes a Data.Version.Version representing the version of the Unicode database used by `base`. This should clear up some confusion I have seen in tickets regarding with which Unicode versions a given GHC can be expected to work. While in town I also regenerated (but did not update) the Unicode database with database 12.0.0. Strangely, the file cited in the README no longer existed. Consequently, I used https://www.unicode.org/Public/12.0.0/ucd/UnicodeData.txt and was slightly surprised to find that there were a few changes. - - - - - 6c2585e0 by Ben Gamari at 2020-02-12T17:22:37-05:00 base: Update Unicode database to 12.1.0 Using `curl https://www.unicode.org/Public/12.1.0/ucd/UnicodeData.txt | libraries/base/cbits/ubconfc 12.1.0`. - - - - - df084681 by Krzysztof Gogolewski at 2020-02-12T23:58:52+01:00 Always display inferred variables using braces We now always show "forall {a}. T" for inferred variables, previously this was controlled by -fprint-explicit-foralls. This implements part 1 of https://github.com/ghc-proposals/ghc-proposals/pull/179. Part of GHC ticket #16320. Furthermore, when printing a levity restriction error, we now display the HsWrap of the expression. This lets users see the full elaboration with -fprint-typechecker-elaboration (see also #17670) - - - - - 16d643cf by Sylvain Henry at 2020-02-13T09:16:04-05:00 Remove -ddump-srts flag This flag is deemed not useful. - - - - - fa28ae95 by Sylvain Henry at 2020-02-13T09:16:04-05:00 Fix flag documentation (#17826) - - - - - 1bfd8259 by Sylvain Henry at 2020-02-13T09:16:43-05:00 Ensure that Hadrian is built correctly before using it When Hadrian failed to build, the script would pick a previously built Hadrian (if available) instead of failing. - - - - - cd6e786a by Ömer Sinan Ağacan at 2020-02-14T05:29:56-05:00 Add test for #17648 - - - - - 9f2c3677 by Sylvain Henry at 2020-02-14T05:30:39-05:00 GMP expects the Target platform as --host parameter - - - - - aa6086fd by Oleg Grenrus at 2020-02-14T05:31:16-05:00 Add explicit LANGUAGE Safe to template-haskell (cherry picked from commit a5e0f376821ca882880b03b07b451aa574e289ec) - - - - - af6a0c36 by Ben Gamari at 2020-02-14T05:31:53-05:00 hadrian: Add execution and target architecture to stage-compilation figure - - - - - cf739945 by Sylvain Henry at 2020-02-14T05:32:37-05:00 Module hierarchy: HsToCore (cf #13009) - - - - - 719db318 by Simon Peyton Jones at 2020-02-14T05:33:16-05:00 De-duplicate overlapping Notes Documentation only. Fixes #17827 - - - - - 7550417a by Sylvain Henry at 2020-02-14T05:33:56-05:00 Hadrian: drop Sphinx flag checking for PDF documentation (#17825) It seems that Sphinx produces the ghc-flags.txt in doc/users_guide/_build rather than pdfRoot. We could copy ghc-flags.txt into pdfRoot (like happens naturally in the HTML case) but the benefit is pretty small. Let's just only check the HTML case. - - - - - 813842f4 by Ben Gamari at 2020-02-14T10:16:36-05:00 make: Be more selective in building windows-extra-src tarball - - - - - 0725f4bb by Ben Gamari at 2020-02-14T10:16:36-05:00 Rework handling of win32 toolchain tarballs - - - - - 565ce7ae by Ben Gamari at 2020-02-14T10:16:36-05:00 gitlab-ci: Consolidate CI logic This moves nearly all of the CI logic to .gitlab/ci.sh. This improves things in a number of ways: * it's harder for inconsistencies to arise between architectures * it's easier to share logic between architectures * on Windows, it's easier to ensure that all CI steps are executed from within a properly initialized mingw session. While in town I also add a FreeBSD build job and update the Windows job to use the gitlab-runner PowerShell executor, since cmd.exe will be deprecated soon (fixing #17699). - - - - - 9cbace74 by Ben Gamari at 2020-02-14T10:16:36-05:00 gitlab-ci: Deduplicate nightly job configuration - - - - - 6e837144 by Ben Gamari at 2020-02-14T10:16:36-05:00 integer-gmp: Fix unused command-line argument -L is only needed during linking. - - - - - e5ee07ab by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite: Don't ask sed to operate in-place on symlinks Some sed implementations (e.g. FreeBSD) refuse to operate in-place on symlinks. - - - - - 71e5e68f by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite: Disable tests that assume name of libstdc++ on FreeBSD - - - - - 7b2da0f4 by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite: Mark T6132 as broken on FreeBSD - - - - - 8ef7a15a by Ben Gamari at 2020-02-14T10:16:36-05:00 testsuite/T16930: Don't rely on gnu grep specific --include In BSD grep this flag only affects directory recursion. - - - - - 6060003e by Ben Gamari at 2020-02-14T10:16:36-05:00 Pass -Wno-unused-command-line-arguments during link on FreeBSD FreeBSD cc throws a warning if we pass -pthread without actually using any pthread symbols. - - - - - 97497bae by Ben Gamari at 2020-02-14T10:16:36-05:00 base: Always clamp reads/writes to 2GB in length Previously we did this only on Darwin due to #17414. However, even on other platforms >2GB writes are on shaky ground. POSIX explicitly says that the result is implementation-specified and Linux will write at most 0x7ffff000, even on 64-bit platforms. Moreover, getting the sign of the syscall result correct is tricky, as demonstrated by the fact that T17414 currently fails on FreeBSD. For simplicity we now just uniformly clamp to 0x7ffff000 on all platforms. - - - - - 49be2a3f by Ben Gamari at 2020-02-14T10:16:36-05:00 configure: Fix sphinx version test The check for the "v" prefix is redundant. - - - - - f7f7a556 by Ben Gamari at 2020-02-14T10:16:37-05:00 users-guide: Fix unknown link targets - - - - - a204102c by Ben Gamari at 2020-02-14T10:16:37-05:00 docs/compare-flags: Don't use python f-strings - - - - - 92e15a37 by Ben Gamari at 2020-02-14T10:16:37-05:00 gitlab-ci: Fix various shellcheck warnings - - - - - 459f7c6e by Ben Gamari at 2020-02-14T10:16:37-05:00 hadrian: Drop empty arguments from target list Fixes #17748. - - - - - c06df28d by Ben Gamari at 2020-02-14T10:16:37-05:00 users-guide: Fix "invalid file" failure I have no idea how this worked previously. Different Python version? - - - - - 3fe8444f by Ben Gamari at 2020-02-14T10:16:59-05:00 testsuite: Mark T7702 as fragile on Windows Due to #16799. There was previously an attempt to mark it as broken but the `opsys` name was incorrect. - - - - - fe02f781 by Ben Gamari at 2020-02-14T10:16:59-05:00 testsuite: Assert the opsys names are known Previously opsys would take any string. This meant it was very easy for a typo to silently render the predicate ineffective. Fix this by checking the given operating system name against a list of known values. - - - - - 149e2a3a by Ben Gamari at 2020-02-14T10:16:59-05:00 compare-flags: Don't rely on encoding flag of subprocess.check_output Apparently it isn't supported by some slightly older Python versions. - - - - - 798d59f6 by Ben Gamari at 2020-02-14T10:16:59-05:00 rts: Add more debug output to failed path in onIOComplete This will help track down #17035. - - - - - e35f3f98 by Ben Gamari at 2020-02-14T10:16:59-05:00 gitlab-ci: Allow i386 Windows builds to fail again Due to the resistance of #17736 to resolution. - - - - - 261a3cf8 by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Build integer-simple job in the validate flavour - - - - - b613a961 by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Always use mingw64 python on Windows - - - - - 1bc8c8cd by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Allow Windows build to fail due to #17777 The fact that `exec` isn't POSIX compliant means that things can break in arbitrarily bad ways. Sometimes things happen to work correctly but sadly this isn't always the case. - - - - - ac63020d by Ben Gamari at 2020-02-14T10:17:00-05:00 gitlab-ci: Drop unnecessary GHC_VERSION check - - - - - 6926f369 by Ben Gamari at 2020-02-14T10:17:00-05:00 Bump process submodule Folds in the second part of Phyx's Windows process exit fixes [1], hopefully finally resolving issue #17480. [1] https://github.com/haskell/process/pull/160 - - - - - 584eee71 by Tamar Christina at 2020-02-14T10:17:00-05:00 SysTools: Use "process job" when spawning processes on Windows GHC should make calls using process jobs when calling out to GCC and LD. The reason is these use the exec () family of posix functions. Window's process model doesn't allow replacement of processes so this is emulated by creating a new process and immediately exiting the old one. Because of this when using normal Windows wait functions you would return even without the child process having finished. In this case if you are depending on data from the child you will enter a race condition. The usual fix for this is to use process jobs and wait for the termination of all children that have ever been spawn by the process you called. But also waiting for the freeing of all resources. - - - - - ecabfa28 by Tamar Christina at 2020-02-14T10:17:00-05:00 Revert "compiler: Disable atomic renaming on Windows" The original reason this was disabled should be fixed by the previous commit. This reverts commit 1c1b63d63efe8b0f789aa7d5b87cfac3edd213eb. - - - - - 06d60c66 by Ben Gamari at 2020-02-14T10:17:00-05:00 Bump Cabal submodule - - - - - 8cabb384 by Ben Gamari at 2020-02-14T10:17:00-05:00 compare-flags: Fix output - - - - - 8cf646d3 by Ben Gamari at 2020-02-14T10:17:00-05:00 users-guide: Document -ddump-srts - - - - - 932307a5 by Ben Gamari at 2020-02-14T10:17:00-05:00 users-guide: Fix broken reference - - - - - e77818de by Ben Gamari at 2020-02-15T09:26:55-05:00 Accept performance changes These manifested in the integer-simple job. Metric Decrease: T12227 T5549 T14936 T4830 Conversions T5237 T8766 T4801 T10359 Metric Increase: T12234 T6048 T3294 T14683 T3064 T9872b T9872c T783 T5837 T10678 T14697 T5631 T9203 T13719 T12707 T13056 T9630 T10547 T9872d T1969 WWRec T10370 T5321FD haddock.Cabal T5642 T9872a T15263 T12425 MultiLayerModules T5205 T9233 T13379 haddock.base T9020 T13035 T12150 T9961 - - - - - 785008c1 by Ben Gamari at 2020-02-15T09:30:13-05:00 testsuite: Sort test names in expected change output - - - - - 9e851472 by Ömer Sinan Ağacan at 2020-02-16T10:38:41+03:00 Revert "users-guide: Document -ddump-srts" This reverts commit 8cf646d36b02b8ea1c289cb52781c9171853b514. The flag was removed by 16d643cf. [ci skip] - - - - - 9792c816 by Ben Gamari at 2020-02-16T09:47:08-05:00 testsuite: Probe whether symlinks are usable on Windows Closes #17706. - - - - - ee1e5342 by Vladislav Zavialov at 2020-02-16T09:47:44-05:00 Fix the "unused terminals: 2" warning in Parser.y - - - - - b4a8ce52 by Roland Senn at 2020-02-18T20:14:42-05:00 If a :reload finds syntax errors in the module graph, remove the loaded modules. (Fixes #17549) The processing in `compiler/main/GhcMake.hs` computes the ModuleGraph. If it finds errors in the module header or in the import specifications, then the new module graph is incomplete and should not be used. The code before #17549 just reported the errors and left the old ModuleGraph in place. The new code of this MR replaces the old ModuleGraph with an empty one. - - - - - d7029cc0 by Sylvain Henry at 2020-02-18T20:15:30-05:00 Hadrian: refactor GMP in-tree build support (#17756) * Hadrian doesn't use integer-gmp/config.mk file anymore to determine if building GMP in-tree is required. "config.mk" is created by Cabal when the integer-gmp package is configured and this file is still untracked by Hadrian. This led to a tricky configure "race" because "config.mk" is built by the "setup-config" rule, but this rule is also used to find dependencies, in particular the "ghc-gmp.h" header, but the creation of this file was depending (without being tracked) on "config.mk". Now Hadrian only builds in-tree GMP if `--with-intree-gmp` is passed to the top-level configure script. * in-tree GMP isn't built once for all in a fixed stage (Stage1) anymore. It is built per stage which is required if we build a cross-compiler * switching between in-tree and external GMP is now supported without having to clean the build directory first. * "wrappers.c" now includes "ghc-gmp.h" instead of "ghc.h". It helps ensuring that the build system generates "ghc-gmp.h". * build in-tree GMP in "<root>/stageN/gmp/gmpbuild" and produce useful artefacts (libgmp.a, gmp.h, objs/*.o) in "<root>/stageN/gmp" - - - - - 40d917fb by Vladislav Zavialov at 2020-02-18T20:16:07-05:00 Remove the MonadFail P instance There were two issues with this instance: * its existence meant that a pattern match failure in the P monad would produce a user-visible parse error, but the error message would not be helpful to the user * due to the MFP migration strategy, we had to use CPP in Lexer.x, and that created issues for #17750 Updates haddock submodule. - - - - - 5a1ce45d by Joshua Price at 2020-02-18T20:16:47-05:00 Fix unboxed tuple size limit (#17837) - - - - - 192caf58 by Vladislav Zavialov at 2020-02-18T20:17:24-05:00 Fix testsuite driver output (#17847) - - - - - 1500f089 by Sylvain Henry at 2020-02-18T20:18:12-05:00 Modules: Llvm (#13009) - - - - - d53e81c0 by Niklas Hambüchen at 2020-02-20T10:36:22-05:00 8.10 Release notes for atomic .o writes [skip ci] - - - - - 19680ee5 by Niklas Hambüchen at 2020-02-20T10:37:53-05:00 8.10 Release notes for --disable-delayed-os-memory-return [skip ci] - - - - - 74ad75e8 by Simon Peyton Jones at 2020-02-20T21:17:57-05:00 Re-implement unsafe coercions in terms of unsafe equality proofs (Commit message written by Omer, most of the code is written by Simon and Richard) See Note [Implementing unsafeCoerce] for how unsafe equality proofs and the new unsafeCoerce# are implemented. New notes added: - [Checking for levity polymorphism] in CoreLint.hs - [Implementing unsafeCoerce] in base/Unsafe/Coerce.hs - [Patching magic definitions] in Desugar.hs - [Wiring in unsafeCoerce#] in Desugar.hs Only breaking change in this patch is unsafeCoerce# is not exported from GHC.Exts, instead of GHC.Prim. Fixes #17443 Fixes #16893 NoFib ----- -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS -0.1% 0.0% -0.0% -0.0% -0.0% CSD -0.1% 0.0% -0.0% -0.0% -0.0% FS -0.1% 0.0% -0.0% -0.0% -0.0% S -0.1% 0.0% -0.0% -0.0% -0.0% VS -0.1% 0.0% -0.0% -0.0% -0.0% VSD -0.1% 0.0% -0.0% -0.0% -0.1% VSM -0.1% 0.0% -0.0% -0.0% -0.0% anna -0.0% 0.0% -0.0% -0.0% -0.0% ansi -0.1% 0.0% -0.0% -0.0% -0.0% atom -0.1% 0.0% -0.0% -0.0% -0.0% awards -0.1% 0.0% -0.0% -0.0% -0.0% banner -0.1% 0.0% -0.0% -0.0% -0.0% bernouilli -0.1% 0.0% -0.0% -0.0% -0.0% binary-trees -0.1% 0.0% -0.0% -0.0% -0.0% boyer -0.1% 0.0% -0.0% -0.0% -0.0% boyer2 -0.1% 0.0% -0.0% -0.0% -0.0% bspt -0.1% 0.0% -0.0% -0.0% -0.0% cacheprof -0.1% 0.0% -0.0% -0.0% -0.0% calendar -0.1% 0.0% -0.0% -0.0% -0.0% cichelli -0.1% 0.0% -0.0% -0.0% -0.0% circsim -0.1% 0.0% -0.0% -0.0% -0.0% clausify -0.1% 0.0% -0.0% -0.0% -0.0% comp_lab_zift -0.1% 0.0% -0.0% -0.0% -0.0% compress -0.1% 0.0% -0.0% -0.0% -0.0% compress2 -0.1% 0.0% -0.0% -0.0% -0.0% constraints -0.1% 0.0% -0.0% -0.0% -0.0% cryptarithm1 -0.1% 0.0% -0.0% -0.0% -0.0% cryptarithm2 -0.1% 0.0% -0.0% -0.0% -0.0% cse -0.1% 0.0% -0.0% -0.0% -0.0% digits-of-e1 -0.1% 0.0% -0.0% -0.0% -0.0% digits-of-e2 -0.1% 0.0% -0.0% -0.0% -0.0% dom-lt -0.1% 0.0% -0.0% -0.0% -0.0% eliza -0.1% 0.0% -0.0% -0.0% -0.0% event -0.1% 0.0% -0.0% -0.0% -0.0% exact-reals -0.1% 0.0% -0.0% -0.0% -0.0% exp3_8 -0.1% 0.0% -0.0% -0.0% -0.0% expert -0.1% 0.0% -0.0% -0.0% -0.0% fannkuch-redux -0.1% 0.0% -0.0% -0.0% -0.0% fasta -0.1% 0.0% -0.5% -0.3% -0.4% fem -0.1% 0.0% -0.0% -0.0% -0.0% fft -0.1% 0.0% -0.0% -0.0% -0.0% fft2 -0.1% 0.0% -0.0% -0.0% -0.0% fibheaps -0.1% 0.0% -0.0% -0.0% -0.0% fish -0.1% 0.0% -0.0% -0.0% -0.0% fluid -0.1% 0.0% -0.0% -0.0% -0.0% fulsom -0.1% 0.0% +0.0% +0.0% +0.0% gamteb -0.1% 0.0% -0.0% -0.0% -0.0% gcd -0.1% 0.0% -0.0% -0.0% -0.0% gen_regexps -0.1% 0.0% -0.0% -0.0% -0.0% genfft -0.1% 0.0% -0.0% -0.0% -0.0% gg -0.1% 0.0% -0.0% -0.0% -0.0% grep -0.1% 0.0% -0.0% -0.0% -0.0% hidden -0.1% 0.0% -0.0% -0.0% -0.0% hpg -0.1% 0.0% -0.0% -0.0% -0.0% ida -0.1% 0.0% -0.0% -0.0% -0.0% infer -0.1% 0.0% -0.0% -0.0% -0.0% integer -0.1% 0.0% -0.0% -0.0% -0.0% integrate -0.1% 0.0% -0.0% -0.0% -0.0% k-nucleotide -0.1% 0.0% -0.0% -0.0% -0.0% kahan -0.1% 0.0% -0.0% -0.0% -0.0% knights -0.1% 0.0% -0.0% -0.0% -0.0% lambda -0.1% 0.0% -0.0% -0.0% -0.0% last-piece -0.1% 0.0% -0.0% -0.0% -0.0% lcss -0.1% 0.0% -0.0% -0.0% -0.0% life -0.1% 0.0% -0.0% -0.0% -0.0% lift -0.1% 0.0% -0.0% -0.0% -0.0% linear -0.1% 0.0% -0.0% -0.0% -0.0% listcompr -0.1% 0.0% -0.0% -0.0% -0.0% listcopy -0.1% 0.0% -0.0% -0.0% -0.0% maillist -0.1% 0.0% -0.0% -0.0% -0.0% mandel -0.1% 0.0% -0.0% -0.0% -0.0% mandel2 -0.1% 0.0% -0.0% -0.0% -0.0% mate -0.1% 0.0% -0.0% -0.0% -0.0% minimax -0.1% 0.0% -0.0% -0.0% -0.0% mkhprog -0.1% 0.0% -0.0% -0.0% -0.0% multiplier -0.1% 0.0% -0.0% -0.0% -0.0% n-body -0.1% 0.0% -0.0% -0.0% -0.0% nucleic2 -0.1% 0.0% -0.0% -0.0% -0.0% para -0.1% 0.0% -0.0% -0.0% -0.0% paraffins -0.1% 0.0% -0.0% -0.0% -0.0% parser -0.1% 0.0% -0.0% -0.0% -0.0% parstof -0.1% 0.0% -0.0% -0.0% -0.0% pic -0.1% 0.0% -0.0% -0.0% -0.0% pidigits -0.1% 0.0% -0.0% -0.0% -0.0% power -0.1% 0.0% -0.0% -0.0% -0.0% pretty -0.1% 0.0% -0.1% -0.1% -0.1% primes -0.1% 0.0% -0.0% -0.0% -0.0% primetest -0.1% 0.0% -0.0% -0.0% -0.0% prolog -0.1% 0.0% -0.0% -0.0% -0.0% puzzle -0.1% 0.0% -0.0% -0.0% -0.0% queens -0.1% 0.0% -0.0% -0.0% -0.0% reptile -0.1% 0.0% -0.0% -0.0% -0.0% reverse-complem -0.1% 0.0% -0.0% -0.0% -0.0% rewrite -0.1% 0.0% -0.0% -0.0% -0.0% rfib -0.1% 0.0% -0.0% -0.0% -0.0% rsa -0.1% 0.0% -0.0% -0.0% -0.0% scc -0.1% 0.0% -0.1% -0.1% -0.1% sched -0.1% 0.0% -0.0% -0.0% -0.0% scs -0.1% 0.0% -0.0% -0.0% -0.0% simple -0.1% 0.0% -0.0% -0.0% -0.0% solid -0.1% 0.0% -0.0% -0.0% -0.0% sorting -0.1% 0.0% -0.0% -0.0% -0.0% spectral-norm -0.1% 0.0% -0.0% -0.0% -0.0% sphere -0.1% 0.0% -0.0% -0.0% -0.0% symalg -0.1% 0.0% -0.0% -0.0% -0.0% tak -0.1% 0.0% -0.0% -0.0% -0.0% transform -0.1% 0.0% -0.0% -0.0% -0.0% treejoin -0.1% 0.0% -0.0% -0.0% -0.0% typecheck -0.1% 0.0% -0.0% -0.0% -0.0% veritas -0.0% 0.0% -0.0% -0.0% -0.0% wang -0.1% 0.0% -0.0% -0.0% -0.0% wave4main -0.1% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 -0.1% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 -0.1% 0.0% -0.0% -0.0% -0.0% x2n1 -0.1% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min -0.1% 0.0% -0.5% -0.3% -0.4% Max -0.0% 0.0% +0.0% +0.0% +0.0% Geometric Mean -0.1% -0.0% -0.0% -0.0% -0.0% Test changes ------------ - break006 is marked as broken, see #17833 - The compiler allocates less when building T14683 (an unsafeCoerce#- heavy happy-generated code) on 64-platforms. Allocates more on 32-bit platforms. - Rest of the increases are tiny amounts (still enough to pass the threshold) in micro-benchmarks. I briefly looked at each one in a profiling build: most of the increased allocations seem to be because of random changes in the generated code. Metric Decrease: T14683 Metric Increase: T12150 T12234 T12425 T13035 T14683 T5837 T6048 Co-Authored-By: Richard Eisenberg <rae at cs.brynmawr.edu> Co-Authored-By: Ömer Sinan Ağacan <omeragacan at gmail.com> - - - - - 6880d6aa by Sylvain Henry at 2020-02-20T21:18:48-05:00 Disentangle DynFlags and SDoc Remove several uses of `sdocWithDynFlags`. The remaining ones are mostly CodeGen related (e.g. depend on target platform constants) and will be fixed separately. Metric Decrease: T12425 T9961 WWRec T1969 T14683 - - - - - 70a90110 by Julien Debon at 2020-02-20T21:19:27-05:00 doc(List): Add examples to GHC.List * Add examples * Cleanup documentation * Clarify merge process and Marge bot - - - - - c8439fc7 by Peter Trommler at 2020-02-20T21:20:05-05:00 Fix testsuite on powerpc64le Remove expect broken on recomp tests, #11260 was closed by !2264 and #11323 most likely by !2264 as well. GHCi scripts tests work on GHCi but not the external interpreter, adjust test configuration accordingly. Fixes unexpected passes. Mark test requiring DWARF expect fail on powerpc64[le] for #11261. - - - - - 65b7256a by Ömer Sinan Ağacan at 2020-02-20T21:20:45-05:00 Use concatMap(M) instead of `concat . map` and the monadic variant - - - - - 8b76d457 by Roland Senn at 2020-02-20T21:21:28-05:00 Fix #17832: Weird handling of exports named main in 8.10-rc1 Switching from `lookupGlobalOccRn_maybe` to `lookupInfoOccRn` to check whether a `main` function is in scope. Unfortunately `lookupGlobalOccRn_maybe` complains if there are multiple `main` functions in scope. - - - - - 466e1ad5 by Krzysztof Gogolewski at 2020-02-20T21:22:11-05:00 Use TTG for HsSplicedT constructor The constructor HsSplicedT occurs only in the GhcTc pass. This enforces this fact statically via TTG. - - - - - 4e622fca by Alexis King at 2020-02-20T21:22:49-05:00 Normalize types when dropping absent arguments from workers fixes #17852 - - - - - a533e547 by Adam Sandberg Eriksson at 2020-02-20T21:23:31-05:00 Mention users guide and release notes in merge request template - - - - - 05251b17 by Ben Gamari at 2020-02-20T21:24:08-05:00 gitlab-ci: Fix typo in BIN_DIST_PREP_TAR_COMP variable name - - - - - f44c7e67 by Ben Gamari at 2020-02-20T21:24:46-05:00 gitlab-ci: Avoid duplicating ~/.cabal contents with every build Previously our attempt to cache the cabal store would `cp cabal-cache ~/.cabal`. However, if the latter already existed this meant that we would end up with ~/.cabal/cabal-cache. Not only would this not help caching but it would exponentially grow the size of ~/.cabal. Not good! - - - - - c5ec9965 by Ben Gamari at 2020-02-20T21:56:13-05:00 GHC.Hs.Extension: Use Type instead of * - - - - - 89cb4cc4 by Ben Gamari at 2020-02-20T21:56:13-05:00 Use Type instead of * in GHC - - - - - 04eb0d6c by Ben Gamari at 2020-02-20T21:56:13-05:00 Enable -Wstar-is-type in -Wall As noted in [proposal 0143][proposal] this is supposed to happen in 8.12. Also fix an incorrect claim in the users guide that -Wstar-is-type is enabled by default. [proposal]: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0143-remove-star-kind.rst - - - - - 6de966f1 by Andreas Klebinger at 2020-02-20T21:56:15-05:00 Fix #17724 by having occAnal preserve used bindings. It sometimes happened that occAnal would remove bindings as dead code by relying on bindings to be in dependency order. The fix was contributed by SPJ. - - - - - abd7f962 by Ben Gamari at 2020-02-20T21:56:15-05:00 users-guide: Mention dependency on `exceptions` in release notes Fixes #17845. - - - - - 58175379 by Sylvain Henry at 2020-02-20T21:56:20-05:00 Hadrian: minor GMP refactoring Somehow I forgot to totally remove `gmpContext` in d7029cc09edc052c2f97effe33233c53340fcce0. This patch fixes it and adds some additional comments. - - - - - 33fa8d94 by Ryan Scott at 2020-02-20T21:56:21-05:00 Generalize liftData to work over any Quote (#17857) The Overloaded Quotations proposal generalized the type of `lift` to work over any `Quote`, but not the type of `liftData`, leading to #17857. Thankfully, generalizing `liftData` is extremely straightforward. Fixes #17857. - - - - - 3cea6795 by Sylvain Henry at 2020-02-20T21:56:23-05:00 Make: fix sdist target (#17848) - - - - - e2cce997 by Sylvain Henry at 2020-02-20T21:56:23-05:00 Hadrian: fix source-dist target (#17849) - - - - - 0a4c89b2 by Matthew Pickering at 2020-02-21T20:44:45-05:00 Special case `mkTyConApp liftedTypeKind []` We really need to make sure that these are shared because otherwise GHC will allocate thousands of identical `TyConApp` nodes. See #17292 ------------------------- Metric Decrease: haddock.Cabal T14683 ------------------------- - - - - - 0482f58a by Matthew Pickering at 2020-02-21T20:45:21-05:00 TH: wrapGenSyns, don't split the element type too much The invariant which allowed the pervious method of splitting the type of the body to find the type of the elements didn't work in the new overloaded quotation world as the type can be something like `WriterT () m a` rather than `Q a` like before. Fixes #17839 - - - - - be7068a6 by Vladislav Zavialov at 2020-02-21T20:45:59-05:00 Parser API annotations: RealSrcLoc During parsing, GHC collects lexical information about AST nodes and stores it in a map. It is needed to faithfully restore original source code, e.g. compare these expressions: a = b a = b The position of the equality sign is not recorded in the AST, so it must be stored elsewhere. This system is described in Note [Api annotations]. Before this patch, the mapping was represented by: Map (SrcSpan, AnnKeywordId) SrcSpan After this patch, the mapping is represented by: Map (RealSrcSpan, AnnKeywordId) RealSrcSpan The motivation behind this change is to avoid using the Ord SrcSpan instance (required by Map here), as it interferes with #17632 (see the discussion there). SrcSpan is isomorphic to Either String RealSrcSpan, but we shouldn't use those strings as Map keys. Those strings are intended as hints to the user, e.g. "<interactive>" or "<compiler-generated code>", so they are not a valid way to identify nodes in the source code. - - - - - 240f5bf6 by Sylvain Henry at 2020-02-21T20:46:40-05:00 Modules: Driver (#13009) submodule updates: nofib, haddock - - - - - 9d094111 by Sylvain Henry at 2020-02-21T20:47:19-05:00 Hadrian: `docs` rule needs `configure` (#17840) - - - - - 1674353a by Ben Gamari at 2020-02-23T17:31:19-05:00 fs: Port fixes from ghc-jailbreak repository * Override rename, unlink, and remove * Factor out wchar conversion - - - - - 853210f2 by Adam Sandberg Ericsson at 2020-02-23T17:32:03-05:00 show gcc linker options in configure summary - - - - - 2831544a by Adam Sandberg Ericsson at 2020-02-23T17:32:44-05:00 hadrian: docs depend on stage1 ghc - - - - - 1d9df9e0 by Adam Sandberg Ericsson at 2020-02-23T17:33:23-05:00 ci: after 5ce63d52fed the linux bindist for doc-tarball has changed name - - - - - 26e8fff3 by Vladislav Zavialov at 2020-02-24T02:05:30-05:00 Remove Ord SrcLoc, Ord SrcSpan Before this patch, GHC relied on Ord SrcSpan to identify source elements, by using SrcSpan as Map keys: blackList :: Map SrcSpan () -- compiler/GHC/HsToCore/Coverage.hs instanceMap :: Map SrcSpan Name -- compiler/GHC/HsToCore/Docs.hs Firstly, this design is not valid in presence of UnhelpfulSpan, as it distinguishes between UnhelpfulSpan "X" and UnhelpfulSpan "Y", but those strings are messages for the user, unfit to serve as identifiers for source elements. Secondly, this design made it hard to extend SrcSpan with additional data. Recall that the definition of SrcSpan is: data SrcSpan = RealSrcSpan !RealSrcSpan | UnhelpfulSpan !FastString Say we want to extend the RealSrcSpan constructor with additional information: data SrcSpan = RealSrcSpan !RealSrcSpan !AdditionalInformation | UnhelpfulSpan !FastString getAdditionalInformation :: SrcSpan -> AdditionalInformation getAdditionalInformation (RealSrcSpan _ a) = a Now, in order for Map SrcSpan to keep working correctly, we must *ignore* additional information when comparing SrcSpan values: instance Ord SrcSpan where compare (RealSrcSpan r1 _) (RealSrcSpan r2 _) = compare r1 r2 ... However, this would violate an important law: a == b therefore f a == f b Ignoring AdditionalInformation in comparisons would mean that with f=getAdditionalInformation, the law above does not hold. A more robust design is to avoid Ord SrcSpan altogether, which is what this patch implements. The mappings are changed to use RealSrcSpan instead: blackList :: Set RealSrcSpan -- compiler/GHC/HsToCore/Coverage.hs instanceMap :: Map RealSrcSpan Name -- compiler/GHC/HsToCore/Docs.hs All SrcSpan comparisons are now done with explicit comparison strategies: SrcLoc.leftmost_smallest SrcLoc.leftmost_largest SrcLoc.rightmost_smallest These strategies are not subject to the law mentioned above and can easily discard both the string stored in UnhelpfulSpan and AdditionalInformation. Updates haddock submodule. - - - - - 5aa6c188 by Ben Gamari at 2020-02-24T02:06:09-05:00 users-guide: Shuffle text - - - - - e3f17413 by Ben Gamari at 2020-02-24T02:06:09-05:00 users-guide: Drop old release notes - - - - - 84dd9610 by Ben Gamari at 2020-02-24T02:06:09-05:00 Bump directory submodule to 1.3.6.0 - - - - - e295a024 by Stefan Pavikevik at 2020-02-24T20:53:44-05:00 check for safe arguments, raising error when invalid (fix #17720) - - - - - 354e2787 by Krzysztof Gogolewski at 2020-02-24T20:54:35-05:00 Comments, small refactor * Remove outdated Note [HsForAllTy tyvar binders] and [Context quantification]. Since the wildcard refactor 1e041b7382, HsForAllTy no longer has an flag controlling explicity. The field `hsq_implicit` is gone too. The current situation is covered by Note [HsType binders] which is already linked from LHsQTyVars. * Small refactor in CoreLint, extracting common code to a function * Remove "not so sure about WpFun" in TcEvidence, per Richard's comment https://gitlab.haskell.org/ghc/ghc/merge_requests/852#note_223226 * Use mkIfThenElse in Foreign/Call, as it does exactly what we need. - - - - - 1b1067d1 by Sylvain Henry at 2020-02-24T20:55:25-05:00 Modules: CmmToAsm (#13009) - - - - - 621468f6 by Alexis King at 2020-02-26T15:08:09-05:00 Treat coercions as arguments for floating and inlining This reverts commit 8924224ecfa065ebc67b96a90d01cf9d2edd0e77 and fixes #17787. - - - - - def486c9 by Ben Gamari at 2020-02-26T15:08:47-05:00 hadrian: Allow libnuma library path to be specified - - - - - ed03d4e7 by Ben Gamari at 2020-02-26T15:08:47-05:00 hadrian: Refactor gmp arguments Move the gmp configuration to its own binding. - - - - - 09b88384 by Ben Gamari at 2020-02-26T15:08:47-05:00 hadrian: Tell Cabal about integer-gmp library location - - - - - 161e08c5 by Krzysztof Gogolewski at 2020-02-26T15:09:30-05:00 Remove dead code * FailablePattern can no longer be created since ab51bee40c82 Therefore, Opt_WarnMissingMonadFailInstances has no effect anymore. * XWrap is no longer used, it was moved to an extension field - - - - - e0d09db3 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Use 8.8.3 to bootstrap on Windows This should fix #17861. - - - - - 972bcf3a by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Fix symlink test Needs to `write` bytes, not str. - - - - - 273e60de by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Add shell subcommand for debugging within CI environment - - - - - 43b13ed3 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Fix colors on Darwin Darwin sh doesn't support \e. - - - - - 217546a7 by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Flush stdout buffers in InitEventLogging Otherwise we are sensitive to libc's buffering strategy. Similar to the issue fixed in 543dfaab166c81f46ac4af76918ce32190aaab22. - - - - - c7d4fa55 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Add run_hadrian subcommand I've ruined two trees already by failing to pass --flavour to hadrian. Let's factor this out so it can be reused during troubleshooting. - - - - - 7dc54873 by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Allow tests to be marked as broken on the command line This allows us to work-around distribution-specific breakage easily. - - - - - 25e2458e by Ben Gamari at 2020-02-26T15:10:09-05:00 hadrian: Add --broken-test flag This exposes the flag of the same name supported by the testsuite driver. - - - - - 55769996 by Ben Gamari at 2020-02-26T15:10:09-05:00 gitlab-ci: Mark some tests as broken on Alpine - - - - - 9ee7f87d by Ben Gamari at 2020-02-26T15:10:09-05:00 SysTools: Don't use process jobs if they are broken - - - - - bfaa3961 by Ben Gamari at 2020-02-26T15:10:09-05:00 Bump hsc2hs submodule Fixes name of C compiler. - - - - - b2b49a0a by Ben Gamari at 2020-02-26T15:10:09-05:00 testsuite: Make hasMetricsFile RHS more descriptive - - - - - 817f93ea by Sylvain Henry at 2020-02-26T15:10:58-05:00 Modules: Core (#13009) Update haddock submodule - - - - - 74311e10 by Sebastian Graf at 2020-02-27T16:22:45-05:00 PmCheck: Implement Long-distance information with Covered sets Consider ```hs data T = A | B | C f :: T -> Int f A = 1 f x = case x of A -> 2 B -> 3 C -> 4 ``` Clearly, the RHS returning 2 is redundant. But we don't currently see that, because our approximation to the covered set of the inner case expression just picks up the positive information from surrounding pattern matches. It lacks the context sensivity that `x` can't be `A` anymore! Therefore, we adopt the conceptually and practically superior approach of reusing the covered set of a particular GRHS from an outer pattern match. In this case, we begin checking the `case` expression with the covered set of `f`s second clause, which encodes the information that `x` can't be `A` anymore. After this MR, we will successfully warn about the RHS returning 2 being redundant. Perhaps surprisingly, this was a great simplification to the code of both the coverage checker and the desugarer. Found a redundant case alternative in `unix` submodule, so we have to bump it with a fix. Metric Decrease: T12227 - - - - - 59c023ba by Adam Sandberg Ericsson at 2020-02-27T16:23:25-05:00 configure: correctly generate LIBRARY_template_haskell_VERSION - - - - - 9be82389 by Krzysztof Gogolewski at 2020-02-28T02:35:35-05:00 boot: Remove remote origin check Previously, we used relative paths in submodules. When cloning from GitHub, they had to be manually tweaked. Since a76b233d we use absolute paths, so this workaround can be removed. - - - - - f4b6b594 by Ben Gamari at 2020-02-28T02:36:12-05:00 nonmoving: Fix marking in compact regions Previously we were tracing the object we were asked to mark, even if it lives in a compact region. However, there is no need to do this; we need only to mark the region itself as live. I have seen a segfault due to this due to the concurrent mark seeing a an object in the process of being compacted by the mutator. - - - - - f97d1fb6 by Alp Mestanogullari at 2020-02-28T02:36:59-05:00 base: use an explicit import list in System.Environment.ExecutablePath This was making -Werror builds fail on Windows (at least with Hadrian). - - - - - 66f5d6d6 by Simon Peyton Jones at 2020-02-28T22:03:23-05:00 Improve error handling for VTA + deferred type errors This fixes #17792 See Note [VTA for out-of-scope functions] in TcExpr - - - - - 37f12603 by Ilias Tsitsimpis at 2020-02-28T22:04:04-05:00 llvm-targets: Add arm-unknown-linux-gnueabi Add arm-unknown-linux-gnueabi, which is used by Debian's ARM EABI port (armel), as an LLVM target. - - - - - 327b29e1 by Vladislav Zavialov at 2020-02-29T05:06:31-05:00 Monotonic locations (#17632) When GHC is parsing a file generated by a tool, e.g. by the C preprocessor, the tool may insert #line pragmas to adjust the locations reported to the user. As the result, the locations recorded in RealSrcLoc are not monotonic. Elements that appear later in the StringBuffer are not guaranteed to have a higher line/column number. In fact, there are no guarantees whatsoever, as #line pragmas can arbitrarily modify locations. This lack of guarantees makes ideas such as #17544 infeasible. This patch adds an additional bit of information to every SrcLoc: newtype BufPos = BufPos { bufPos :: Int } A BufPos represents the location in the StringBuffer, unaffected by any pragmas. Updates haddock submodule. Metric Increase: haddock.Cabal haddock.base haddock.compiler MultiLayerModules Naperian parsing001 T12150 - - - - - 99d2de86 by Ben Gamari at 2020-02-29T05:07:10-05:00 plugins: Ensure that loadInterface plugins can see annotations loadInterface replaces the `mi_decls`, `mi_insts`, `mi_fam_insts`, `mi_rules`, `mi_anns` fields of ModIface with `undefined` before inserting the interface into the EPS. However, we still want to give loadInterface plugins access to these fields. Consequently, we want to pass the unmodified `ModIface` the plugin. - - - - - a999ee96 by Xavier Denis at 2020-02-29T05:07:50-05:00 Rename ghci.sh and build.sh to ghci and build respectively Convert hadrian buildscripts to unsuffixed, dashed form final cleanups - - - - - b5fb58fd by Ömer Sinan Ağacan at 2020-02-29T05:08:36-05:00 Document and refactor a few things around bitmap scavenging - Added a few comments in StgPAP - Added a few comments and assertions in scavenge_small_bitmap and walk_large_bitmap - Did tiny refactor in GHC.Data.Bitmap: added some comments, deleted dead code, used PlatformWordSize type. - - - - - 18757cab by Sylvain Henry at 2020-02-29T05:09:25-05:00 Refactor runtime interpreter code In #14335 we want to be able to use both the internal interpreter (for the plugins) and the external interpreter (for TH and GHCi) at the same time. This patch performs some preliminary refactoring: the `hsc_interp` field of HscEnv replaces `hsc_iserv` and is now used to indicate which interpreter (internal, external) to use to execute TH and GHCi. Opt_ExternalInterpreter flag and iserv options in DynFlags are now queried only when we set the session DynFlags. It should help making GHC multi-target in the future by selecting an interpreter according to the selected target. - - - - - b86a6395 by Adam Sandberg Ericsson at 2020-02-29T05:10:06-05:00 docs: correct relative links to haddocks from users guide (fixes #17866) - - - - - 0f55df7f by Adam Sandberg Ericsson at 2020-02-29T05:10:06-05:00 docs: correct link to th haddocks from users guide - - - - - 252e5117 by Jean-Baptiste Mazon at 2020-02-29T05:10:46-05:00 rts: enforce POSIX numeric locale for heap profiles - - - - - 34c7d230 by Sylvain Henry at 2020-02-29T05:11:27-05:00 Fix Hadrian's ``--configure`` (fix #17883) - - - - - 04d30137 by Ömer Sinan Ağacan at 2020-02-29T05:12:06-05:00 Simplify IfaceIdInfo type IfaceIdInfo type is confusing: there's practically no difference between `NoInfo` and `HasInfo []`. The comments say NoInfo is used when -fomit-interface-pragmas is enabled, but we don't need to distinguish `NoInfo` from `HasInfo []` in when reading the interface so the distinction is not important. This patch simplifies the type by removing NoInfo. When we have no info we use an empty list. With this change we no longer read the info list lazily when reading an IfaceInfoItem, but when reading an IfaceId the ifIdInfo field is read lazily, so I doubt this is going to be a problem. - - - - - 3979485b by Roland Senn at 2020-02-29T17:36:59+01:00 Show breakpoint locations of breakpoints which were ignored during :force (#2950) GHCi is split up into 2 major parts: The user-interface (UI) and the byte-code interpreter. With `-fexternal-interpreter` they even run in different processes. Communication between the UI and the Interpreter (called `iserv`) is done using messages over a pipe. This is called `Remote GHCI` and explained in the Note [Remote GHCi] in `compiler/ghci/GHCi.hs`. To process a `:force` command the UI sends a `Seq` message to the `iserv` process. Then `iserv` does the effective evaluation of the value. When during this process a breakpoint is hit, the `iserv` process has no additional information to enhance the `Ignoring breakpoint` output with the breakpoint location. To be able to print additional breakpoint information, there are 2 possible implementation choices: 1. Store the needed information in the `iserv` process. 2. Print the `Ignoring breakpoint` from the UI process. For option 1 we need to store the breakpoint info redundantely in 2 places and this is bad. Therfore option 2 was implemented in this MR: - The user enters a `force` command - The UI sends a `Seq` message to the `iserv` process. - If processing of the `Seq` message hits a breakpoint, the `iserv` process returns control to the UI process. - The UI looks up the source location of the breakpoint, and prints the enhanced `Ignoring breakpoint` output. - The UI sends a `ResumeSeq` message to the `iserv` process, to continue forcing. - - - - - 3cf7303b by Krzysztof Gogolewski at 2020-03-02T01:18:33-05:00 Remove dead code * The names in PrelName and THNames are no longer used since TH merged types and kinds, Typeable is kind-polymorphic, .net support was removed * unqualQuasiQuote no longer used since 6f8ff0bbad3b9fa3 - - - - - dbea7e9d by Ilias Tsitsimpis at 2020-03-02T01:19:12-05:00 Do not define hs_atomic{read,write}64() on non-64bit Do not define hs_atomicread64() and hs_atomicwrite64() on machines where WORD_SIZE_IN_BITS is less than 64, just like we do with the rest of the atomic functions which work on 64-bit values. Without this, compilation fails on MIPSel and PowerPC with the following error: /usr/bin/ld: /<<PKGBUILDDIR>>/libraries/ghc-prim/dist-install/build/libHSghc-prim-0.5.3_p.a(atomic.p_o): in function `hs_atomicread64': atomic.c:(.text.hs_atomicread64+0x8): undefined reference to `__sync_add_and_fetch_8' /usr/bin/ld: /<<PKGBUILDDIR>>/libraries/ghc-prim/dist-install/build/libHSghc-prim-0.5.3_p.a(atomic.p_o): in function `hs_atomicwrite64': atomic.c:(.text.hs_atomicwrite64+0x38): undefined reference to `__sync_bool_compare_and_swap_8' Fixes #17886. - - - - - 7c0c76fb by Roland Senn at 2020-03-02T17:13:55-05:00 Set `ImpredicativeTypes` during :print command. (#14828) If ImpredicativeTypes is not enabled, then `:print <term>` will fail if the type of <term> has nested `forall`s or `=>`s. This is because the GHCi debugger's internals will attempt to unify a metavariable with the type of <term> and then display the result, but if the type has nested `forall`s or `=>`s, then unification will fail. As a result, `:print` will bail out and the unhelpful result will be `<term> = (_t1::t1)` (where `t1` is a metavariable). Beware: <term> can have nested `forall`s even if its definition doesn't use RankNTypes! Here is an example from #14828: class Functor f where fmap :: (a -> b) -> f a -> f b Somewhat surprisingly, `:print fmap` considers the type of fmap to have nested foralls. This is because the GHCi debugger sees the type `fmap :: forall f. Functor f => forall a b. (a -> b) -> f a -> f b`. We could envision deeply instantiating this type to get the type `forall f a b. Functor f => (a -> b) -> f a -> f b`, but this trick wouldn't work for higher-rank types. Instead, we adopt a simpler fix: enable `ImpredicativeTypes` when using `:print` and friends in the GHCi debugger. This is allows metavariables to unify with types that have nested (or higher-rank) `forall`s/`=>`s, which makes `:print fmap` display as `fmap = (_t1::forall a b. Functor f => (a -> b) -> f a -> f b)`, as expected. Although ImpredicativeTypes is a somewhat unpredictable from a type inference perspective, there is no danger in using it in the GHCi debugger, since all of the terms that the GHCi debugger deals with have already been typechecked. - - - - - 2a2f51d7 by Sylvain Henry at 2020-03-02T17:14:38-05:00 Use configure script to detect that we should use in-tree GMP on Windows - - - - - 8c663c2c by Andreas Klebinger at 2020-03-04T16:12:14+01:00 Be explicit about how stack usage of mvar primops are covered. This fixes #17893 [skip-ci] - - - - - cedd6f30 by Ben Gamari at 2020-03-05T14:53:12-05:00 rts: Add getCurrentThreadCPUTime helper - - - - - ace618cd by Ben Gamari at 2020-03-05T14:53:12-05:00 nonmoving-gc: Track time usage of nonmoving marking - - - - - 022b5ad5 by Ben Gamari at 2020-03-05T14:53:12-05:00 Stats: Add sync pauses to +RTS -S output - - - - - 06763234 by Ben Gamari at 2020-03-05T14:53:12-05:00 rts: Report nonmoving collector statistics in machine-readable output - - - - - 70d2b995 by Ben Gamari at 2020-03-09T06:10:52-04:00 nonmoving: Fix collection of sparks Previously sparks living in the non-moving heap would be promptly GC'd by the minor collector since pruneSparkQueue uses the BF_EVACUATED flag, which non-moving heap blocks do not have set. Fix this by implementing proper support in pruneSparkQueue for determining reachability in the non-moving heap. The story is told in Note [Spark management in the nonmoving heap]. - - - - - 9668781a by Ben Gamari at 2020-03-09T06:11:30-04:00 gitlab-ci: Disable Sphinx documentation in Alpine build - - - - - 8eb2c263 by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 Fix Windows breakage by not touching locales on Windows - - - - - b8dab057 by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 rts: ensure C numerics in heap profiles using Windows locales if needed - - - - - 7d95260f by Jean-Baptiste Mazon at 2020-03-09T16:33:37-04:00 rts: refactor and comment profile locales - - - - - 5b627813 by Ryan Scott at 2020-03-09T16:34:14-04:00 Use InstanceSigs in GND/DerivingVia-generated code (#17899) Aside from making the generated code easier to read when `-ddump-deriv` is enabled, this makes the error message in `T15073` substantially simpler (see the updated `T15073` expected stderr). Fixes #17899. - - - - - 70b50778 by Ben Gamari at 2020-03-10T02:05:42-04:00 SysTools: Ensure that error parser can handle absolute paths on Windows This fixes #17786, where the error parser fails to correctly handle the drive name in absolute Windows paths. Unfortunately I couldn't find a satisfactory way to test this. - - - - - 85b861d8 by Ben Gamari at 2020-03-10T02:05:42-04:00 testsuite: Add test for #17786 This isn't pretty but it's perhaps better than nothing. - - - - - ee2c50cb by Sylvain Henry at 2020-03-10T02:06:33-04:00 Hadrian: track missing configure results - - - - - ca8f51d4 by Ömer Sinan Ağacan at 2020-03-10T02:07:22-04:00 Add regression test for T17904 Closes #17904 - - - - - 5fa9cb82 by Richard Eisenberg at 2020-03-10T12:29:46-04:00 anyRewritableTyVar now looks in RuntimeReps Previously, anyRewritableTyVar looked only at the arg and res of `arg -> res`, but their RuntimeReps are also subject to rewriting. Easy to fix. Test case: typecheck/should_compile/T17024 Fixes #17024. - - - - - 5ba01d83 by Ben Price at 2020-03-10T12:30:27-04:00 Clarify a Lint message When developing a plugin I had a shadowing problem, where I generated code app = \f{v r7B} x{v r7B} -> f{v r7B} x{v r7B} This is obviously wrong, since the occurrence of `f` to the right of the arrow refers to the `x` binder (they share a Unique). However, it is rather confusing when Lint reports Mismatch in type between binder and occurrence Var: x{v rB7} since it is printing the binder, rather than the occurrence. It is rather easy to read this as claiming there is something wrong with the `x` occurrence! We change the report to explicitly print both the binder and the occurrence variables. - - - - - 7b2c827b by Simon Peyton Jones at 2020-03-10T12:31:15-04:00 Comments only Clarify code added in #17852 and MR !2724 - - - - - 3300eeac by Krzysztof Gogolewski at 2020-03-10T12:31:54-04:00 Misc cleanup - Remove Note [Existentials in shift_con_pat]. The function shift_con_pat has been removed 15 years ago in 23f40f0e9be6d4. - Remove kcLookupTcTyCon - it's the same as tcLookupTcTyCon - Remove ASSERT in tyConAppArgN. It's already done by getNth, and it's the only reason getNth exists. - Remove unused function nextRole - - - - - abf5736b by Krzysztof Gogolewski at 2020-03-10T18:05:01+01:00 Typos in comments [skip ci] - - - - - bb586f89 by Ben Gamari at 2020-03-11T00:14:59-04:00 rts: Prefer darwin-specific getCurrentThreadCPUTime macOS Catalina now supports a non-POSIX-compliant version of clock_gettime which cannot use the clock_gettime codepath. Fixes #17906. - - - - - 20800b9a by Sylvain Henry at 2020-03-11T08:17:19-04:00 Split GHC.Iface.Utils module * GHC.Iface.Recomp: recompilation avoidance stuff * GHC.Iface.Make: mkIface* Moved `writeIfaceFile` into GHC.Iface.Load alongside `readIface` and renamed it `writeIface` for consistency. - - - - - 1daa2029 by Greg Steuck at 2020-03-11T08:17:56-04:00 Fixed a minor typo in codegen.rst - - - - - 0bc23338 by Ryan Scott at 2020-03-11T08:18:32-04:00 Re-quantify when generalising over rewrite rule types Previously, `tcRules` would check for naughty quantification candidates (see `Note [Naughty quantification candidates]` in `TcMType`) when generalising over the type of a rewrite rule. This caused sensible-looking rewrite rules (like those in #17710) to be rejected. A more permissing (and easier-to-implement) approach is to do what is described in `Note [Generalising in tcTyFamInstEqnGuts]` in `TcTyClsDecls`: just re-quantify all the type variable binders, regardless of the order in which the user specified them. After all, the notion of type variable specificity has no real meaning in rewrite rules, since one cannot "visibly apply" a rewrite rule. I have written up this wisdom in `Note [Re-quantify type variables in rules]` in `TcRules`. As a result of this patch, compiling the `ExplicitForAllRules1` test case now generates one fewer warning than it used to. As far as I can tell, this is benign, since the thing that the disappearing warning talked about was also mentioned in an entirely separate warning. Fixes #17710. - - - - - 336eac7e by Ben Gamari at 2020-03-11T08:19:08-04:00 testsuite: Mark ghci056 and ghcilink004 as fragile in unreg As noted in #17018. Also fix fragile declaration of T13786, which only runs in the normal way. - - - - - c61b9b02 by Simon Peyton Jones at 2020-03-11T08:19:44-04:00 Deepen call stack for isIn I see quite a few warnings like: WARNING: file compiler/utils/Util.hs, line 593 Over-long elem in unionLists But the call stack is uninformative. Better to add HasDebugCallStack to isIn. Ditto isn'tIn. - - - - - 3aa9b35f by Ömer Sinan Ağacan at 2020-03-11T08:20:27-04:00 Zero any slop after compaction in compacting GC In copying GC, with the relevant debug flags enabled, we release the old blocks after a GC, and the block allocator zeroes the space before releasing a block. This effectively zeros the old heap. In compacting GC we reuse the blocks and previously we didn't zero the unused space in a compacting generation after compaction. With this patch we zero the slop between the free pointer and the end of the block when we're done with compaction and when switching to a new block (because the current block doesn't have enough space for the next object we're shifting). - - - - - 8e6febce by Sylvain Henry at 2020-03-11T20:33:37-04:00 Refactor GHC.Driver.Session (Ways and Flags) * extract flags and ways into their own modules (with some renaming) * remove one SOURCE import of GHC.Driver.Session from GHC.Driver.Phases * when GHC uses dynamic linking (WayDyn), `interpWays` was only reporting WayDyn even if the host was profiled (WayProf). Now it returns both as expected (might fix #16803). * `mkBuildTag :: [Way] -> String` wasn't reporting a canonical tag for differently ordered lists. Now we sort and nub the list to fix this. - - - - - bc41e471 by Sylvain Henry at 2020-03-11T20:33:37-04:00 Refactor interpreterDynamic and interpreterProfiled * `interpreterDynamic` and `interpreterProfiled` now take `Interp` parameters instead of DynFlags * slight refactoring of `ExternalInterp` so that we can read the iserv configuration (which is pure) without reading an MVar. - - - - - a6989971 by Sylvain Henry at 2020-03-11T20:33:37-04:00 Use a Set to represent Ways Should make `member` queries faster and avoid messing up with missing `nubSort`. Metric Increase: hie002 - - - - - cb93a1a4 by Ryan Scott at 2020-03-11T20:34:14-04:00 Make DeriveFunctor-generated code require fewer beta reductions Issue #17880 demonstrates that `DeriveFunctor`-generated code is surprisingly fragile when rank-_n_ types are involved. The culprit is that `$fmap` (the algorithm used to generate `fmap` implementations) was too keen on applying arguments with rank-_n_ types to lambdas, which fail to typecheck more often than not. In this patch, I change `$fmap` (both the specification and the implementation) to produce code that avoids creating as many lambdas, avoiding problems when rank-_n_ field types arise. See the comments titled "Functor instances" in `TcGenFunctor` for a more detailed description. Not only does this fix #17880, but it also ensures that the code that `DeriveFunctor` generates will continue to work after simplified subsumption is implemented (see #17775). What is truly amazing is that #17880 is actually a regression (introduced in GHC 7.6.3) caused by commit 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e, the fix #7436. Prior to that commit, the version of `$fmap` that was used was almost identical to the one used in this patch! Why did that commit change `$fmap` then? It was to avoid severe performance issues that would arise for recursive `fmap` implementations, such as in the example below: ```hs data List a = Nil | Cons a (List a) deriving Functor -- ===> instance Functor List where fmap f Nil = Nil fmap f (Cons x xs) = Cons (f x) (fmap (\y -> f y) xs) ``` The fact that `\y -> f y` was eta expanded caused significant performance overheads. Commit 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e fixed this performance issue, but it went too far. As a result, this patch partially reverts 49ca2a37bef18aa57235ff1dbbf1cc0434979b1e. To ensure that the performance issues pre-#7436 do not resurface, I have taken some precautionary measures: * I have added a special case to `$fmap` for situations where the last type variable in an application of some type occurs directly. If this special case fires, we avoid creating a lambda expression. This ensures that we generate `fmap f (Cons x xs) = Cons (f x) (fmap f xs)` in the derived `Functor List` instance above. For more details, see `Note [Avoid unnecessary eta expansion in derived fmap implementations]` in `TcGenFunctor`. * I have added a `T7436b` test case to ensure that the performance of this derived `Functor List`-style code does not regress. When implementing this, I discovered that `$replace`, the algorithm which generates implementations of `(<$)`, has a special case that is very similar to the `$fmap` special case described above. `$replace` marked this special case with a custom `Replacer` data type, which was a bit overkill. In order to use the same machinery for both `Functor` methods, I ripped out `Replacer` and instead implemented a simple way to detect the special case. See the updated commentary in `Note [Deriving <$]` for more details. - - - - - 1f9db3e7 by Kirill Elagin at 2020-03-12T09:45:51-04:00 pretty-printer: Properly parenthesise LastStmt After ApplicatveDo strips the last `return` during renaming, the pretty printer has to restore it. However, if the return was followed by `$`, the dollar was stripped too and not restored. For example, the last stamement in: ``` foo = do x <- ... ... return $ f x ``` would be printed as: ``` return f x ``` This commit preserved the dolar, so it becomes: ``` return $ f x ``` - - - - - 5cb93af7 by Kirill Elagin at 2020-03-12T09:45:51-04:00 pretty-printer: Do not print ApplicativeDo join * Do not print `join` in ApplictiveStmt, unless ppr-debug * Print parens around multiple parallel binds When ApplicativeDo is enabled, the renamer analyses the statements of a `do` block and in certain cases marks them as needing to be rewritten using `join`. For example, if you have: ``` foo = do a <- e1 b <- e2 doSomething a b ``` it will be desugared into: ``` foo = join (doSomething <$> e1 <*> e2) ``` After renaming but before desugaring the expression is stored essentially as: ``` foo = do [will need join] (a <- e1 | b <- e2) [no return] doSomething a b ``` Before this change, the pretty printer would print a call to `join`, even though it is not needed at this stage at all. The expression will be actually rewritten into one using join only at desugaring, at which point a literal call to join will be inserted. - - - - - 3a259092 by Simon Peyton Jones at 2020-03-12T09:46:29-04:00 Expose compulsory unfoldings always The unsafeCoerce# patch requires that unsafeCoerce# has a compulsory unfolding that is always available. So we have to be careful to expose compulsory unfoldings unconditionally and consistently. We didn't get this quite right: #17871. This patch fixes it. No real surprises here. See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy - - - - - 6a65b8c2 by Alp Mestanogullari at 2020-03-13T02:29:20-04:00 hadrian: improve dependency tracking for the check-* programs The code in Rules.Register responsible for finding all the build artifacts that Cabal installs when registering a library (static/shared libs, .hi files, ...) was looking in the wrong place. This patch fixes that logic and makes sure we gather all those artifacts in a list to declare that the rule for a given `.conf` file, our proxy for "Hadrian, please install this package in the package db for this stage", also produces those artifacts under the said package database. We also were completely missing some logic to declare that the check-* programs have dependencies besides their source code, at least when testing an in-tree compiler. Finally, this patch also removes redundant packages from 'testsuitePackages', since they should already be covered by the stage<N>Packages lists from Settings.Default. With this patch, after a complete build and freezing stage 1, a change to `compiler/parser/Parser.y` results in rebuilding the ghc lib, reinstalling it, and rebuilding the few programs that depend on it, _including_ `check-ppr` and `check-api-annotations` (therefore fixing #17273). - - - - - 44fad4a9 by Sylvain Henry at 2020-03-13T02:30:22-04:00 Rename isDllName I wanted to fix the dangling comment in `isDllName` ("This is the cause of #", #8696 is already mentioned earlier). I took the opportunity to change the function name to better reflect what it does. - - - - - 2f292db8 by Paavo at 2020-03-13T02:31:03-04:00 Update documentation for closureSize - - - - - f124ff0d by Ben Gamari at 2020-03-13T02:31:40-04:00 gitlab-ci: Rework triggering of release builds Use a push option instead of tagging. - - - - - 7f25557a by Ben Gamari at 2020-03-13T10:38:09-04:00 gitlab-ci: Distinguish integer-simple test envs Previously two integer-simple jobs declared the same test environment. One (the nightly job) was built in the perf way, the other in the validate way. Consequently they had appreciably different performance characteristics, causing in the nightly job to spuriously fail with performance changes. - - - - - c12a2ec5 by Simon Peyton Jones at 2020-03-14T05:25:30-04:00 Fix Lint Ticket #17590 pointed out a bug in the way the linter dealt with type lets, exposed by the new uniqAway story. The fix is described in Note [Linting type lets]. I ended up putting the in-scope Ids in a different env field, le_ids, rather than (as before) sneaking them into the TCvSubst. Surprisingly tiresome, but done. Metric Decrease: hie002 - - - - - b989845e by Sylvain Henry at 2020-03-14T05:26:11-04:00 Hadrian: fix absolute buildroot support (#17822) Shake's "**" wildcard doesn't match absolute root. We must use "//" instead. - - - - - 4f117135 by Sylvain Henry at 2020-03-14T05:26:49-04:00 Make: refactor GMP rules Document and use simpler rules for the ghc-gmp.h header. - - - - - 7432b327 by Sylvain Henry at 2020-03-14T05:27:28-04:00 Use correct option name (-opti) (fix #17314) s/pgmo/opti - - - - - 8f7dd571 by Judah Jacobson at 2020-03-14T05:28:07-04:00 Allow overriding LD_STAGE0 and AR_STAGE0 in the configure script. Previously it was possible to override the stage0 C compiler via `CC_STAGE0`, but you couldn't override `ld` or `ar` in stage0. This change allows overriding them by setting `LD_STAGE0` or `AR_STAGE0`, respectively. Our team uses this feature internally to take more control of our GHC build and make it run more hermetically. - - - - - 7c3e39a9 by Judah Jacobson at 2020-03-14T05:28:07-04:00 Use AC_ARG_VAR for LD_STAGE0 and AR_STAGE0. - - - - - 20d4d676 by Ben Gamari at 2020-03-14T05:28:43-04:00 nonmoving: Don't traverse filled segment list in pause The non-moving collector would previously walk the entire filled segment list during the preparatory pause. However, this is far more work than is strictly necessary. We can rather get away with merely collecting the allocators' filled segment list heads and process the lists themselves during the concurrent phase. This can significantly reduce the maximum gen1 GC pause time in programs with high rates of long-lived allocations. - - - - - fdfa2d01 by Ben Gamari at 2020-03-14T05:29:18-04:00 nonmoving: Remove redundant bitmap clearing nonmovingSweep already clears the bitmap in the sweep loop. There is no reason to do so a second time. - - - - - 2f8c7767 by Simon Peyton Jones at 2020-03-14T05:29:55-04:00 Simple refactor of cheapEqExpr No change in functionality. Just seems tidier (and signficantly more efficient) to deal with ticks directly than to call stripTicksTopE. - - - - - 88f7a762 by Simon Peyton Jones at 2020-03-14T05:29:55-04:00 Improve CSE.combineAlts This patch improves the way that CSE combines identical alternatives. See #17901. I'm still not happy about the duplication between CSE.combineAlts and GHC.Core.Utils.combineIdenticalAlts; see the Notes with those functions. But this patch is a step forward. Metric Decrease: T12425 T5642 - - - - - 8b95ddd3 by Ben Gamari at 2020-03-14T05:30:31-04:00 gitlab-ci: Add integer-simple release build for Windows Closes #16144. - - - - - e3c374cc by Simon Peyton Jones at 2020-03-14T05:31:07-04:00 Wrap an implication around class-sig kind errors Ticket #17841 showed that we can get a kind error in a class signature, but lack an enclosing implication that binds its skolems. This patch * Adds the wrapping implication: the new call to checkTvConstraints in tcClassDecl1 * Simplifies the API to checkTvConstraints, which was not otherwise called at all. * Simplifies TcErrors.report_unsolved by *not* initialising the TidyEnv from the typechecker lexical envt. It's enough to do so from the free vars of the unsolved constraints; and we get silly renamings if we add variables twice: once from the lexical scope and once from the implication constraint. - - - - - 73133a3b by Simon Peyton Jones at 2020-03-14T05:31:07-04:00 Refactoring in TcSMonad This patch is just refactoring: no change in behaviour. I removed the rather complicated checkConstraintsTcS checkTvConstraintsTcS in favour of simpler functions emitImplicationTcS emitTvImplicationTcS pushLevelNoWorkList The last of these is a little strange, but overall it's much better I think. - - - - - 93c88c26 by Ben Gamari at 2020-03-14T05:31:42-04:00 base: Make `open` calls interruptible As noted in #17912, `open` system calls were `safe` rather than `interruptible`. Consequently, the program could not be interrupted with SIGINT if stuck in a slow open operation. Fix this by marking `c_safe_open` as interruptible. - - - - - bee4cdad by Vladislav Zavialov at 2020-03-14T05:32:18-04:00 Remove second tcLookupTcTyCon in tcDataDefn Before this patch, tcDataDefn used to call tcLookupTcTyCon twice in a row: 1. in bindTyClTyVars itself 2. in the continuation passed to it Now bindTyClTyVars passes the TcTyCon to the continuation, making the second lookup unnecessary. - - - - - 3f116d35 by Cale Gibbard at 2020-03-14T19:34:42-04:00 Enable stage1 build of haddock The submodule has already been bumped to contain the fix. - - - - - 49e9d739 by Ömer Sinan Ağacan at 2020-03-14T19:35:24-04:00 rts: Fix printClosure when printing fwd ptrs - - - - - 1de3ab4a by Krzysztof Gogolewski at 2020-03-14T19:36:04-04:00 Remove unused field var_inline (#17915) - - - - - d30aeb4b by Krzysztof Gogolewski at 2020-03-15T03:57:41-04:00 Document restriction on SCC pragma syntax Currently, the names of cost centres must be quoted or be lowercase identifiers. Fixes #17916. - - - - - b4774598 by Brian Foley at 2020-03-15T03:58:18-04:00 Remove some dead code >From the notes.ghc.drop list found using weeder in #17713 - - - - - dd6ffe6b by Viktor Dukhovni at 2020-03-15T03:58:55-04:00 Note platform-specific Foreign.C.Types in context Also fix the markup in the general note at the top of the module. Haddock (usability trade-off), does not support multi-line emphasised text. - - - - - 2e82465f by Sylvain Henry at 2020-03-15T10:57:10-04:00 Refactor CmmToAsm (disentangle DynFlags) This patch disentangles a bit more DynFlags from the native code generator (CmmToAsm). In more details: - add a new NCGConfig datatype in GHC.CmmToAsm.Config which contains the configuration of a native code generation session - explicitly pass NCGConfig/Platform arguments when necessary - as a consequence `sdocWithPlatform` is gone and there are only a few `sdocWithDynFlags` left - remove the use of `unsafeGlobalDynFlags` from GHC.CmmToAsm.CFG - remove `sdocDebugLevel` (now we pass the debug level via NCGConfig) There are still some places where DynFlags is used, especially because of pretty-printing (CLabel), because of Cmm helpers (such as `cmmExprType`) and because of `Outputable` instance for the instructions. These are left for future refactoring as this patch is already big. - - - - - c35c545d by Judah Jacobson at 2020-03-15T10:57:48-04:00 Add a -no-haddock flag. This flag undoes the effect of a previous "-haddock" flag. Having both flags makes it easier for build systems to enable Haddock parsing in a set of global flags, but then disable it locally for specific targets (e.g., third-party packages whose comments don't pass the validation in the latest GHC). I added the flag to expected-undocumented-flags.txt since `-haddock` was alreadyin that list. - - - - - cfcc3c9a by Ömer Sinan Ağacan at 2020-03-15T10:58:27-04:00 Fix global_link of TSOs for threads reachable via dead weaks Fixes #17785 Here's how the problem occurs: - In generation 0 we have a TSO that is finished (i.e. it has no more work to do or it is killed). - The TSO only becomes reachable after collectDeadWeakPtrs(). - After collectDeadWeakPtrs() we switch to WeakDone phase where we don't move TSOs to different lists anymore (like the next gen's thread list or the resurrected_threads list). - So the TSO will never be moved to a generation's thread list, but it will be promoted to generation 1. - Generation 1 collected via mark-compact, and because the TSO is reachable it is marked, and its `global_link` field, which is bogus at this point (because the TSO is not in a list), will be threaded. - Chaos ensues. In other words, when these conditions hold: - A TSO is reachable only after collectDeadWeakPtrs() - It's finished (what_next is ThreadComplete or ThreadKilled) - It's retained by mark-compact collector (moving collector doesn't evacuate the global_list field) We end up doing random mutations on the heap because the TSO's global_list field is not valid, but it still looks like a heap pointer so we thread it during compacting GC. The fix is simple: when we traverse old_threads lists to resurrect unreachable threads the threads that won't be resurrected currently stays on the old_threads lists. Those threads will never be visited again by MarkWeak so we now reset the global_list fields. This way compacting GC does not thread pointers to nowhere. Testing ------- The reproducer in #17785 is quite large and hard to build, because of the dependencies, so I'm not adding a regression test. In my testing the reproducer would take a less than 5 seconds to run, and once in every ~5 runs would fail with a segfault or an assertion error. In other cases it also fails with a test failure. Because the tests never fail with the bug fix, assuming the code is correct, this also means that this bug can sometimes lead to incorrect runtime results. After the fix I was able to run the reproducer repeatedly for about an hour, with no runtime crashes or test failures. To run the reproducer clone the git repo: $ git clone https://github.com/osa1/streamly --branch ghc-segfault Then clone primitive and atomic-primops from their git repos and point to the clones in cabal.project.local. The project should then be buildable using GHC HEAD. Run the executable `properties` with `+RTS -c -DZ`. In addition to the reproducer above I run the test suite using: $ make slowtest EXTRA_HC_OPTS="-debug -with-rtsopts=-DS \ -with-rtsopts=-c +RTS -c -RTS" SKIPWAY='nonmoving nonmoving_thr' This enables compacting GC always in both GHC when building the test programs and when running the test programs, and also enables sanity checking when running the test programs. These set of flags are not compatible for all tests so there are some failures, but I got the same set of failures with this patch compared to GHC HEAD. - - - - - 818b3c38 by Lysxia at 2020-03-16T23:52:42-04:00 base: add strict IO functions: readFile', getContents', hGetContents' - - - - - 18a346a4 by Sylvain Henry at 2020-03-16T23:53:24-04:00 Modules: Core (#13009) Update submodule: haddock - - - - - 92327e3a by Ömer Sinan Ağacan at 2020-03-16T23:54:04-04:00 Update sanity checking for TSOs: - Remove an invalid assumption about GC checking what_next field. The GC doesn't care about what_next at all, if a TSO is reachable then all its pointers are followed (other than global_tso, which is only followed by compacting GC). - Remove checkSTACK in checkTSO: TSO stacks will be visited in checkHeapChain, or checkLargeObjects etc. - Add an assertion in checkTSO to check that the global_link field is sane. - Did some refactor to remove forward decls in checkGlobalTSOList and added braces around single-statement if statements. - - - - - e1aa4052 by PHO at 2020-03-17T07:36:09-04:00 Don't use non-portable operator "==" in configure.ac The test operator "==" is a Bash extension and produces a wrong result if /bin/sh is not Bash. - - - - - 89f034dd by Maximilian Tagher at 2020-03-17T07:36:48-04:00 Document the units of -ddump-timings Right now, in the output of -ddump-timings to a file, you can't tell what the units are: ``` CodeGen [TemplateTestImports]: alloc=22454880 time=14.597 ``` I believe bytes/milliseconds are the correct units, but confirmation would be appreciated. I'm basing it off of this snippet from `withTiming'`: ``` when (verbosity dflags >= 2 && prtimings == PrintTimings) $ liftIO $ logInfo dflags (defaultUserStyle dflags) (text "!!!" <+> what <> colon <+> text "finished in" <+> doublePrec 2 time <+> text "milliseconds" <> comma <+> text "allocated" <+> doublePrec 3 (realToFrac alloc / 1024 / 1024) <+> text "megabytes") ``` which implies time is in milliseconds, and allocations in bytes (which divided by 1024 would be KB, and again would be MB) - - - - - beffa147 by Simon Peyton Jones at 2020-03-17T07:37:25-04:00 Implement mapTyCo like foldTyCo This patch makes mapType use the successful idiom described in TyCoRep Note [Specialising foldType] I have not yet changed any functions to use mapType, though there may be some suitable candidates. This patch should be a no-op in terms of functionality but, because it inlines the mapper itself, I'm hoping that there may be some modest perf improvements. Metric Decrease: T5631 T5642 T3064 T9020 T14683 hie002 haddock.Cabal haddock.base haddock.compiler - - - - - 5800ebfe by Ömer Sinan Ağacan at 2020-03-17T07:38:08-04:00 Don't update ModDetails with CafInfos when opts are disabled This is consistent with the interface file behavior where we omit HsNoCafRefs annotations with -fomit-interface-pragmas (implied by -O0). ModDetails and ModIface are just different representations of the same thing, so they really need to be in sync. This patch does the right thing and does not need too much explanation, but here's an example of a problem not doing this causes in !2842: -- MyInteger.hs module MyInteger ( MyInteger (MyInteger) , ToMyInteger (toMyInteger) ) where newtype MyInteger = MyInteger Integer class ToMyInteger a where toMyInteger :: a -> MyInteger instance ToMyInteger Integer where toMyInteger = MyInteger {- . succ -} -- Main.hs module Main ( main ) where import MyInteger (MyInteger (MyInteger), toMyInteger) main :: IO () main = do let (MyInteger i) = (id . toMyInteger) (41 :: Integer) print i If I build this with -O0, without this fix, we generate a ModDetails with accurate LFInfo for toMyInteger (MyInteger.$fToMyIntegerInteger) which says that it's a LFReEntrant with arity 1. This means in the use site (Main) we tag the value: R3 = MyInteger.$fToMyIntegerInteger_closure + 1; R2 = GHC.Base.id_closure; R1 = GHC.Base.._closure; Sp = Sp - 16; call stg_ap_ppp_fast(R4, R3, R2, R1) args: 24, res: 0, upd: 24; Now we change the definition by uncommenting the `succ` part and it becomes a thunk: MyInteger.$fToMyIntegerInteger [InlPrag=INLINE (sat-args=0)] :: MyInteger.ToMyInteger GHC.Integer.Type.Integer [GblId[DFunId(nt)]] = {} \u [] $ctoMyInteger_rEA; and its LFInfo is now LFThunk. This change in LFInfo makes a difference in the use site: we can no longer tag it. But becuase the interface fingerprint does not change (because ModIface does not change) we don't rebuild Main and tag the thunk. (1.2% increase in allocations when building T12545 on armv7 because we generate more code without CafInfos) Metric Increase: T12545 - - - - - 5b632dad by Paavo at 2020-03-17T07:38:48-04:00 Add example for Data.Semigroup.diff - - - - - 4d85d68b by Paavo at 2020-03-17T07:38:48-04:00 Clean up - - - - - 75168d07 by Paavo at 2020-03-17T07:38:48-04:00 Make example collapsible - - - - - 53ff2cd0 by Richard Eisenberg at 2020-03-17T13:46:57+00:00 Fix #17021 by checking more return kinds All the details are in new Note [Datatype return kinds] in TcTyClsDecls. Test case: typecheck/should_fail/T17021{,b} typecheck/should_compile/T17021a Updates haddock submodule - - - - - 528df8ec by Sylvain Henry at 2020-03-18T10:06:43-04:00 Modules: Core operations (#13009) - - - - - 4e8a71c1 by Richard Eisenberg at 2020-03-18T10:07:19-04:00 Add release note about fix to #16502. We thought we needed to update the manual, but the fix for #16502 actually brings the implementation in line with the manual. So we just alert users of how to update their code. - - - - - 5cbf9934 by Andreas Klebinger at 2020-03-19T00:39:27-04:00 Update "GHC differences to the FFI Chapter" in user guide. The old entry had a heavy focus on how things had been. Which is not what I generally look for in a user guide. I also added a small section on behaviour of nested safe ffi calls. [skip-ci] - - - - - b03fd3bc by Sebastian Graf at 2020-03-19T00:40:06-04:00 PmCheck: Use ConLikeSet to model negative info In #17911, Simon recognised many warnings stemming from over-long list unions while coverage checking Cabal's `LicenseId` module. This patch introduces a new `PmAltConSet` type which uses a `UniqDSet` instead of an association list for `ConLike`s. For `PmLit`s, it will still use an assocation list, though, because a similar map data structure would entail a lot of busy work. Fixes #17911. - - - - - 64f20756 by Sylvain Henry at 2020-03-19T12:16:49-04:00 Refactoring: use Platform instead of DynFlags when possible Metric Decrease: ManyConstructors T12707 T13035 T1969 - - - - - cb1785d9 by Ömer Sinan Ağacan at 2020-03-19T12:16:54-04:00 FastString: fix eager reading of string ptr in hashStr This read causes NULL dereferencing when len is 0. Fixes #17909 In the reproducer in #17909 this bug is triggered as follows: - SimplOpt.dealWithStringLiteral is called with a single-char string ("=" in #17909) - tailFS gets called on the FastString of the single-char string. - tailFS checks the length of the string, which is 1, and calls mkFastStringByteString on the tail of the ByteString, which is an empty ByteString as the original ByteString has only one char. - ByteString's unsafeUseAsCStringLen returns (NULL, 0) for the empty ByteString, which is passed to mkFastStringWith. - mkFastStringWith gets hash of the NULL pointer via hashStr, which fails on empty strings because of this bug. - - - - - 73a7383e by Richard Eisenberg at 2020-03-20T20:42:56-04:00 Simplify treatment of heterogeneous equality Previously, if we had a [W] (a :: k1) ~ (rhs :: k2), we would spit out a [D] k1 ~ k2 and part the W as irreducible, hoping for a unification. But we needn't do this. Instead, we now spit out a [W] co :: k2 ~ k1 and then use co to cast the rhs of the original Wanted. This means that we retain the connection between the spat-out constraint and the original. The problem with this new approach is that we cannot use the casted equality for substitution; it's too like wanteds-rewriting- wanteds. So, we forbid CTyEqCans that mention coercion holes. All the details are in Note [Equalities with incompatible kinds] in TcCanonical. There are a few knock-on effects, documented where they occur. While debugging an error in this patch, Simon and I ran into infelicities in how patterns and matches are printed; we made small improvements. This patch includes mitigations for #17828, which causes spurious pattern-match warnings. When #17828 is fixed, these lines should be removed. - - - - - faa36e5b by Sylvain Henry at 2020-03-20T20:43:41-04:00 Hadrian: ignore in-tree GMP objects with ``--lint`` - - - - - 9a96ff6b by Richard Eisenberg at 2020-03-20T20:44:17-04:00 Update core spec to reflect changes to Core. Key changes: * Adds a new rule for forall-coercions over coercion variables, which was implemented but conspicuously missing from the spec. * Adds treatment for FunCo. * Adds treatment for ForAllTy over coercion variables. * Improves commentary (including restoring a Note lost in 03d4852658e1b7407abb4da84b1b03bfa6f6db3b) in the source. No changes to running code. - - - - - 7e0451c6 by Sergej Jaskiewicz at 2020-03-20T20:44:55-04:00 Fix event message in withTiming' This typo caused generating 'end' events without the corresponding 'begin' events. - - - - - 1542a626 by Ben Gamari at 2020-03-22T22:37:47-04:00 fs.h: Add missing declarations on Windows - - - - - 3bcf2ccd by Ben Gamari at 2020-03-22T22:37:47-04:00 Bump process submodule Avoids redundant case alternative warning. - - - - - 3b363ef9 by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Normalize slashes in ghc-api annotations output Enable `normalise_slashes` on `annotations`, `listcomps`, and `parseTree` to fix Windows failures. - - - - - 25fc9429 by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Update expected output on Windows - - - - - 7f58ec6d by Ben Gamari at 2020-03-22T22:37:47-04:00 testsuite: Fix TOP of T17786 - - - - - aadcd909 by GHC GitLab CI at 2020-03-22T22:37:47-04:00 testsuite: Update expected output on Windows - - - - - dc1eb10d by GHC GitLab CI at 2020-03-22T22:37:47-04:00 hadrian: Fix executable extension passed to testsuite driver - - - - - 58f62e2c by GHC GitLab CI at 2020-03-22T22:37:47-04:00 gitlab-ci: Require that Windows-hadrian job passes - - - - - 8dd2415d by Ben Gamari at 2020-03-22T22:37:47-04:00 hadrian: Eliminate redundant .exe from GHC path Previously we were invoking: bash -c "c:/GitLabRunner/builds/eEQrxK4p/0/ghc/ghc/toolchain/bin/ghc.exe.exe testsuite/mk/ghc-config.hs -o _build/test/bin/ghc-config.exe" - - - - - 373621f6 by Ben Gamari at 2020-03-22T22:37:47-04:00 Bump hsc2hs submodule - - - - - abc02b40 by Hécate at 2020-03-22T22:38:33-04:00 Annotate the non-total function in Data.Foldable as such - - - - - 19f12557 by Josef Svenningsson at 2020-03-23T14:05:33-04:00 Fix ApplicativeDo regression #17835 A previous fix for #15344 made sure that monadic 'fail' is used properly when translating ApplicativeDo. However, it didn't properly account for when a 'fail' will be inserted which resulted in some programs failing with a type error. - - - - - 2643ba46 by Paavo at 2020-03-24T08:31:32-04:00 Add example and doc for Arg (Fixes #17153) - - - - - 703221f4 by Roland Senn at 2020-03-25T14:45:04-04:00 Use export list of Main module in function TcRnDriver.hs:check_main (Fix #16453) - Provide the export list of the `Main` module as parameter to the `compiler/typecheck/TcRnDriver.hs:check_main` function. - Instead of `lookupOccRn_maybe` call the function `lookupInfoOccRn`. It returns the list `mains_all` of all the main functions in scope. - Select from this list `mains_all` all `main` functions that are in the export list of the `Main` module. - If this new list contains exactly one single `main` function, then typechecking continues. - Otherwise issue an appropriate error message. - - - - - 3e27205a by Sebastian Graf at 2020-03-25T14:45:40-04:00 Remove -fkill-absence and -fkill-one-shot flags They seem to be a benchmarking vestige of the Cardinality paper and probably shouldn't have been merged to HEAD in the first place. - - - - - 262e42aa by Peter Trommler at 2020-03-25T22:41:39-04:00 Do not panic on linker errors - - - - - 0de03cd7 by Sylvain Henry at 2020-03-25T22:42:02-04:00 DynFlags refactoring III Use Platform instead of DynFlags when possible: * `tARGET_MIN_INT` et al. replaced with `platformMinInt` et al. * no more DynFlags in PreRules: added a new `RuleOpts` datatype * don't use `wORD_SIZE` in the compiler * make `wordAlignment` use `Platform` * make `dOUBLE_SIZE` a constant Metric Decrease: T13035 T1969 - - - - - 7a04920b by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: fix a typo in liftA doc This change removes an extra '|' that should not be rendered in the liftA documentation. Tracking: #17929 - - - - - 1c5a15f7 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add Control.Applicative optional example This change adds an optional example. Tracking: #17929 - - - - - 6d172e63 by Tristan Cacqueray at 2020-03-25T22:42:06-04:00 Base: add markup around Except - - - - - eb2162c8 by John Ericson at 2020-03-26T12:37:08-04:00 Remove unused `ghciTablesNextToCode` from compiler proper - - - - - f51efc4b by Joachim Breitner at 2020-03-26T12:37:09-04:00 Prepare to use run-time tablesNextToCode in compiler exclusively Factor out CPP as much as possible to prepare for runtime determinattion. Progress towards #15548 - - - - - 1c446220 by Joachim Breitner at 2020-03-26T12:37:09-04:00 Use run-time tablesNextToCode in compiler exclusively (#15548) Summary: - There is no more use of the TABLES_NEXT_TO_CODE CPP macro in `compiler/`. GHCI_TABLES_NEXT_TO_CODE is also removed entirely. The field within `PlatformMisc` within `DynFlags` is used instead. - The field is still not exposed as a CLI flag. We might consider some way to ensure the right RTS / libraries are used before doing that. Original reviewers: Original subscribers: TerrorJack, rwbarton, carter Original Differential Revision: https://phabricator.haskell.org/D5082 - - - - - 1941ef4f by Sylvain Henry at 2020-03-29T17:28:51-04:00 Modules: Types (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - 1c7c6f1a by Sylvain Henry at 2020-03-29T17:28:51-04:00 Remove GHC.Types.Unique.Map module This module isn't used anywhere in GHC. - - - - - f1a6c73d by Sylvain Henry at 2020-03-29T17:28:51-04:00 Merge GHC.Types.CostCentre.Init into GHC.Driver.CodeOutput - - - - - 54250f2d by Simon Peyton Jones at 2020-03-29T17:29:30-04:00 Demand analysis: simplify the demand for a RHS Ticket #17932 showed that we were using a stupid demand for the RHS of a let-binding, when the result is a product. This was the result of a "fix" in 2013, which (happily) turns out to no longer be necessary. So I just deleted the code, which simplifies the demand analyser, and fixes #17932. That in turn uncovered that the anticipation of worker/wrapper in CPR analysis was inaccurate, hence the logic that decides whether to unbox an argument in WW was extracted into a function `wantToUnbox`, now consulted by CPR analysis. I tried nofib, and got 0.0% perf changes. All this came up when messing about with !2873 (ticket #17917), but is idependent of it. Unfortunately, this patch regresses #4267 and realised that it is now blocked on #16335. - - - - - 03060b2f by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 on Windows Fixes line ending normalization issue. - - - - - 1f7995ba by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Fix T17786 Fix missing quoting and expected exit code. - - - - - ef9c608e by Ben Gamari at 2020-03-29T17:30:05-04:00 testsuite: Mark T12971 as broken on Windows Due to #17945. - - - - - e54500c1 by Sylvain Henry at 2020-03-29T17:30:47-04:00 Store ComponentId details As far as GHC is concerned, installed package components ("units") are identified by an opaque ComponentId string provided by Cabal. But we don't want to display it to users (as it contains a hash) so GHC queries the database to retrieve some infos about the original source package (name, version, component name). This patch caches these infos in the ComponentId itself so that we don't need to provide DynFlags (which contains installed package informations) to print a ComponentId. In the future we want GHC to support several independent package states (e.g. for plugins and for target code), hence we need to avoid implicitly querying a single global package state. - - - - - 7e7cb714 by Marius Bakke at 2020-03-29T17:31:27-04:00 testsuite: Remove test that dlopens a PIE object. glibc 2.30 disallowed dlopening PIE objects, so just remove the test. Fixes #17952. - - - - - 6c8f80d8 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Correct haddocks for testBit in Data.Bits It conflated the nth bit with the bit at offset n. Now we instead give the definition in terms of `bit and `.&.` on top of clearer phrasing. - - - - - c916f190 by Andreas Klebinger at 2020-03-29T17:32:04-04:00 Apply suggestion to libraries/base/Data/Bits.hs - - - - - 64bf7f51 by Ben Gamari at 2020-03-29T17:32:41-04:00 gitlab-ci: Add FreeBSD release job - - - - - a0d8e92e by Ryan Scott at 2020-03-29T17:33:20-04:00 Run checkNewDataCon before constraint-solving newtype constructors Within `checkValidDataCon`, we used to run `checkValidType` on the argument types of a newtype constructor before running `checkNewDataCon`, which ensures that the user does not attempt non-sensical things such as newtypes with multiple arguments or constraints. This works out in most situations, but this falls over on a corner case revealed in #17955: ```hs newtype T = Coercible () T => T () ``` `checkValidType`, among other things, peforms an ambiguity check on the context of a data constructor, and that it turn invokes the constraint solver. It turns out that there is a special case in the constraint solver for representational equalities (read: `Coercible` constraints) that causes newtypes to be unwrapped (see `Note [Unwrap newtypes first]` in `TcCanonical`). This special case does not know how to cope with an ill formed newtype like `T`, so it ends up panicking. The solution is surprisingly simple: just invoke `checkNewDataCon` before `checkValidType` to ensure that the illicit newtype constructor context is detected before the constraint solver can run amok with it. Fixes #17955. - - - - - 45eb9d8c by Krzysztof Gogolewski at 2020-03-29T17:33:59-04:00 Minor cleanup - Simplify mkBuildExpr, the function newTyVars was called only on a one-element list. - TTG: use noExtCon in more places. This is more future-proof. - In zonkExpr, panic instead of printing a warning. - - - - - f024b6e3 by Sylvain Henry at 2020-03-30T12:48:39+02:00 Expect T4267 to pass Since 54250f2d8de910b094070c1b48f086030df634b1 we expected T4267 to fail, but it passes on CI. - - - - - 57b888c0 by Ryan Scott at 2020-03-31T10:54:20-04:00 Require GHC 8.8 as the minimum compiler for bootstrapping This allows us to remove several bits of CPP that are either always true or no longer reachable. As an added bonus, we no longer need to worry about importing `Control.Monad.Fail.fail` qualified to avoid clashing with `Control.Monad.fail`, since the latter is now the same as the former. - - - - - 33f09551 by Ryan Scott at 2020-03-31T10:54:57-04:00 Add regression test for #17963 The panic in #17963 happened to be fixed by commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70. This patch adds a regression test to ensure that it remains fixed. Fixes #17963. - - - - - 09a36e80 by Ömer Sinan Ağacan at 2020-03-31T10:55:37-04:00 Simplify stderrSupportsAnsiColors The combinator andM is used only once, and the code is shorter and simpler if you inline it. - - - - - 95bccdd0 by Ben Gamari at 2020-03-31T10:56:19-04:00 base: Ensure that encoding global variables aren't inlined As noted in #17970, these (e.g. `getFileSystemEncoding` and `setFileSystemEncoding`) previously had unfoldings, which would break their global-ness. While not strictly necessary, I also add a NOINLINE on `initLocaleEncoding` since it is used in `System.IO`, ensuring that we only system's query the locale encoding once. Fixes #17970. - - - - - 982aaa83 by Andreas Klebinger at 2020-03-31T10:56:55-04:00 Update hadrian index revision. Required in order to build hadrian using ghc-8.10 - - - - - 4b9c5864 by Ben Gamari at 2020-03-31T10:57:32-04:00 integer-gmp: Bump version and add changelog entry - - - - - 9b39f2e6 by Ryan Scott at 2020-04-01T01:20:00-04:00 Clean up "Eta reduction for data families" Notes Before, there were two distinct Notes named "Eta reduction for data families". This renames one of them to "Implementing eta reduction for data families" to disambiguate the two and fixes references in other parts of the codebase to ensure that they are pointing to the right place. Fixes #17313. [ci skip] - - - - - 7627eab5 by Ryan Scott at 2020-04-01T01:20:38-04:00 Fix the changelog/@since information for hGetContents'/getContents'/readFile' Fixes #17979. [ci skip] - - - - - 0002db1b by Sylvain Henry at 2020-04-01T01:21:27-04:00 Kill wORDS_BIGENDIAN and replace it with platformByteOrder (#17957) Metric Decrease: T13035 T1969 - - - - - 7b217179 by Sebastian Graf at 2020-04-01T15:03:24-04:00 PmCheck: Adjust recursion depth for inhabitation test In #17977, we ran into the reduction depth limit of the typechecker. That was only a symptom of a much broader issue: The recursion depth of the coverage checker for trying to instantiate strict fields in the `nonVoid` test was far too high (100, the `defaultMaxTcBound`). As a result, we were performing quite poorly on `T17977`. Short of a proper termination analysis to prove emptyness of a type, we just arbitrarily default to a much lower recursion limit of 3. Fixes #17977. - - - - - 3c09f636 by Andreas Klebinger at 2020-04-01T15:03:59-04:00 Make hadrian pass on the no-colour setting to GHC. Fixes #17983. - - - - - b943b25d by Simon Peyton Jones at 2020-04-02T01:45:58-04:00 Re-engineer the binder-swap transformation The binder-swap transformation is implemented by the occurrence analyser -- see Note [Binder swap] in OccurAnal. However it had a very nasty corner in it, for the case where the case scrutinee was a GlobalId. This led to trouble and hacks, and ultimately to #16296. This patch re-engineers how the occurrence analyser implements the binder-swap, by actually carrying out a substitution rather than by adding a let-binding. It's all described in Note [The binder-swap substitution]. I did a few other things along the way * Fix a bug in StgCse, which could allow a loop breaker to be CSE'd away. See Note [Care with loop breakers] in StgCse. I think it can only show up if occurrence analyser sets up bad loop breakers, but still. * Better commenting in SimplUtils.prepareAlts * A little refactoring in CoreUnfold; nothing significant e.g. rename CoreUnfold.mkTopUnfolding to mkFinalUnfolding * Renamed CoreSyn.isFragileUnfolding to hasCoreUnfolding * Move mkRuleInfo to CoreFVs We observed respectively 4.6% and 5.9% allocation decreases for the following tests: Metric Decrease: T9961 haddock.base - - - - - 42d68364 by Sebastian Graf at 2020-04-02T01:46:34-04:00 Preserve precise exceptions in strictness analysis Fix #13380 and #17676 by 1. Changing `raiseIO#` to have `topDiv` instead of `botDiv` 2. Give it special treatment in `Simplifier.Util.mkArgInfo`, treating it as if it still had `botDiv`, to recover dead code elimination. This is the first commit of the plan outlined in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2525#note_260886. - - - - - 0a88dd11 by Ömer Sinan Ağacan at 2020-04-02T01:47:25-04:00 Fix a pointer format string in RTS - - - - - 5beac042 by Ömer Sinan Ağacan at 2020-04-02T01:48:05-04:00 Remove unused closure stg_IND_direct - - - - - 88f38b03 by Ben Gamari at 2020-04-02T01:48:42-04:00 Session: Memoize stderrSupportsAnsiColors Not only is this a reasonable efficiency measure but it avoids making reentrant calls into ncurses, which is not thread-safe. See #17922. - - - - - 27740f24 by Ryan Scott at 2020-04-02T01:49:21-04:00 Make Hadrian build with Cabal-3.2 GHC 8.10 ships with `Cabal-3.2.0.0`, so it would be convenient to make Hadrian supporting building against 3.2.* instead of having to rebuild the entirety of `Cabal-3.0.0.0`. There is one API change in `Cabal-3.2.*` that affects Hadrian: the `synopsis` and `description` functions now return `ShortText` instead of `String`. Since Hadrian manipulates these `String`s in various places, I found that the simplest fix was to use CPP to convert `ShortText` to `String`s where appropriate. - - - - - 49802002 by Sylvain Henry at 2020-04-02T01:50:00-04:00 Update Stack resolver for hadrian/build-stack Broken by 57b888c0e90be7189285a6b078c30b26d0923809 - - - - - 30a63e79 by Ryan Scott at 2020-04-02T01:50:36-04:00 Fix two ASSERT buglets in reifyDataCon Two `ASSERT`s in `reifyDataCon` were always using `arg_tys`, but `arg_tys` is not meaningful for GADT constructors. In fact, it's worse than non-meaningful, since using `arg_tys` when reifying a GADT constructor can lead to failed `ASSERT`ions, as #17305 demonstrates. This patch applies the simplest possible fix to the immediate problem. The `ASSERT`s now use `r_arg_tys` instead of `arg_tys`, as the former makes sure to give something meaningful for GADT constructors. This makes the panic go away at the very least. There is still an underlying issue with the way the internals of `reifyDataCon` work, as described in https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227023, but we leave that as future work, since fixing the underlying issue is much trickier (see https://gitlab.haskell.org/ghc/ghc/issues/17305#note_227087). - - - - - ef7576c4 by Zubin Duggal at 2020-04-03T06:24:56-04:00 Add outputable instances for the types in GHC.Iface.Ext.Types, add -ddump-hie flag to dump pretty printed contents of the .hie file Metric Increase: hie002 Because of the regression on i386: compile_time/bytes allocated increased from i386-linux-deb9 baseline @ HEAD~10: Expected hie002 (normal) compile_time/bytes allocated: 583014888.0 +/-10% Lower bound hie002 (normal) compile_time/bytes allocated: 524713399 Upper bound hie002 (normal) compile_time/bytes allocated: 641316377 Actual hie002 (normal) compile_time/bytes allocated: 877986292 Deviation hie002 (normal) compile_time/bytes allocated: 50.6 % *** unexpected stat test failure for hie002(normal) - - - - - 9462452a by Andreas Klebinger at 2020-04-03T06:25:33-04:00 Improve and refactor StgToCmm codegen for DataCons. We now differentiate three cases of constructor bindings: 1)Bindings which we can "replace" with a reference to an existing closure. Reference the replacement closure when accessing the binding. 2)Bindings which we can "replace" as above. But we still generate a closure which will be referenced by modules importing this binding. 3)For any other binding generate a closure. Then reference it. Before this patch 1) did only apply to local bindings and we didn't do 2) at all. - - - - - a214d214 by Moritz Bruder at 2020-04-03T06:26:11-04:00 Add singleton to NonEmpty in libraries/base This adds a definition to construct a singleton non-empty list (Data.List.NonEmpty) according to issue #17851. - - - - - f7597aa0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Testsuite: measure compiler stats for T16190 We were mistakenly measuring program stats - - - - - a485c3c4 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Move blob handling into StgToCmm Move handling of big literal strings from CmmToAsm to StgToCmm. It avoids the use of `sdocWithDynFlags` (cf #10143). We might need to move this handling even higher in the pipeline in the future (cf #17960): this patch will make it easier. - - - - - cc2918a0 by Sylvain Henry at 2020-04-03T06:26:54-04:00 Refactor CmmStatics In !2959 we noticed that there was some redundant code (in GHC.Cmm.Utils and GHC.Cmm.StgToCmm.Utils) used to deal with `CmmStatics` datatype (before SRT generation) and `RawCmmStatics` datatype (after SRT generation). This patch removes this redundant code by using a single GADT for (Raw)CmmStatics. - - - - - 9e60273d by Maxim Koltsov at 2020-04-03T06:27:32-04:00 Fix haddock formatting in Control.Monad.ST.Lazy.Imp.hs - - - - - 1b7e8a94 by Andreas Klebinger at 2020-04-03T06:28:08-04:00 Turn newlines into spaces for hadrian/ghci. The newlines break the command on windows. - - - - - 4291bdda by Simon Peyton Jones at 2020-04-03T06:28:44-04:00 Major improvements to the specialiser This patch is joint work of Alexis King and Simon PJ. It does some significant refactoring of the type-class specialiser. Main highlights: * We can specialise functions with types like f :: Eq a => a -> Ord b => b => blah where the classes aren't all at the front (#16473). Here we can correctly specialise 'f' based on a call like f @Int @Bool dEqInt x dOrdBool This change really happened in an earlier patch commit 2d0cf6252957b8980d89481ecd0b79891da4b14b Author: Sandy Maguire <sandy at sandymaguire.me> Date: Thu May 16 12:12:10 2019 -0400 work that this new patch builds directly on that work, and refactors it a bit. * We can specialise functions with implicit parameters (#17930) g :: (?foo :: Bool, Show a) => a -> String Previously we could not, but now they behave just like a non-class argument as in 'f' above. * We can specialise under-saturated calls, where some (but not all of the dictionary arguments are provided (#17966). For example, we can specialise the above 'f' based on a call map (f @Int dEqInt) xs even though we don't (and can't) give Ord dictionary. This may sound exotic, but #17966 is a program from the wild, and showed significant perf loss for functions like f, if you need saturation of all dictionaries. * We fix a buglet in which a floated dictionary had a bogus demand (#17810), by using zapIdDemandInfo in the NonRec case of specBind. * A tiny side benefit: we can drop dead arguments to specialised functions; see Note [Drop dead args from specialisations] * Fixed a bug in deciding what dictionaries are "interesting"; see Note [Keep the old dictionaries interesting] This is all achieved by by building on Sandy Macguire's work in defining SpecArg, which mkCallUDs uses to describe the arguments of the call. Main changes: * Main work is in specHeader, which marched down the [InBndr] from the function definition and the [SpecArg] from the call site, together. * specCalls no longer has an arity check; the entire mechanism now handles unders-saturated calls fine. * mkCallUDs decides on an argument-by-argument basis whether to specialise a particular dictionary argument; this is new. See mk_spec_arg in mkCallUDs. It looks as if there are many more lines of code, but I think that all the extra lines are comments! - - - - - 40a85563 by Ömer Sinan Ağacan at 2020-04-03T18:26:19+03:00 Revert accidental change in 9462452 [ci skip] - - - - - bd75e5da by Ryan Scott at 2020-04-04T07:07:58-04:00 Enable ImpredicativeTypes internally when typechecking selector bindings This is necessary for certain record selectors with higher-rank types, such as the examples in #18005. See `Note [Impredicative record selectors]` in `TcTyDecls`. Fixes #18005. - - - - - dcfe29c8 by Ömer Sinan Ağacan at 2020-04-06T13:16:08-04:00 Don't override proc CafInfos in ticky builds Fixes #17947 When we have a ticky label for a proc, IdLabels for the ticky counter and proc entry share the same Name. This caused overriding proc CafInfos with the ticky CafInfos (i.e. NoCafRefs) during SRT analysis. We now ignore the ticky labels when building SRTMaps. This makes sense because: - When building the current module they don't need to be in SRTMaps as they're initialized as non-CAFFY (see mkRednCountsLabel), so they don't take part in the dependency analysis and they're never added to SRTs. (Reminder: a "dependency" in the SRT analysis is a CAFFY dependency, non-CAFFY uses are not considered as dependencies for the algorithm) - They don't appear in the interfaces as they're not exported, so it doesn't matter for cross-module concerns whether they're in the SRTMap or not. See also the new Note [Ticky labels in SRT analysis]. - - - - - cec2c71f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Fix an tricky specialiser loop Issue #17151 was a very tricky example of a bug in which the specialiser accidentally constructs a recurive dictionary, so that everything turns into bottom. I have fixed variants of this bug at least twice before: see Note [Avoiding loops]. It was a bit of a struggle to isolate the problem, greatly aided by the work that Alexey Kuleshevich did in distilling a test case. Once I'd understood the problem, it was not difficult to fix, though it did lead me a bit of refactoring in specImports. - - - - - e850d14f by Simon Peyton Jones at 2020-04-06T13:16:44-04:00 Refactoring only This refactors DictBinds into a data type rather than a pair. No change in behaviour, just better code - - - - - f38e8d61 by Daniel Gröber at 2020-04-07T02:00:05-04:00 rts: ProfHeap: Fix memory leak when not compiled with profiling If we're doing heap profiling on an unprofiled executable we keep allocating new space in initEra via nextEra on each profiler run but we don't have a corresponding freeEra call. We do free the last era in endHeapProfiling but previous eras will have been overwritten by initEra and will never get free()ed. Metric Decrease: space_leak_001 - - - - - bcd66859 by Sebastian Graf at 2020-04-07T02:00:41-04:00 Re-export GHC.Magic.noinline from base - - - - - 3d2991f8 by Ben Gamari at 2020-04-07T18:36:09-04:00 simplifier: Kill off ufKeenessFactor We used to have another factor, ufKeenessFactor, which would scale the discounts before they were subtracted from the size. This was justified with the following comment: -- We multiple the raw discounts (args_discount and result_discount) -- ty opt_UnfoldingKeenessFactor because the former have to do with -- *size* whereas the discounts imply that there's some extra -- *efficiency* to be gained (e.g. beta reductions, case reductions) -- by inlining. However, this is highly suspect since it means that we subtract a *scaled* size from an absolute size, resulting in crazy (e.g. negative) scores in some cases (#15304). We consequently killed off ufKeenessFactor and bumped up the ufUseThreshold to compensate. Adjustment of unfolding use threshold ===================================== Since this removes a discount from our inlining heuristic, I revisited our default choice of -funfolding-use-threshold to minimize the change in overall inlining behavior. Specifically, I measured runtime allocations and executable size of nofib and the testsuite performance tests built using compilers (and core libraries) built with several values of -funfolding-use-threshold. This comes as a result of a quantitative comparison of testsuite performance and code size as a function of ufUseThreshold, comparing GHC trees using values of 50, 60, 70, 80, 90, and 100. The test set consisted of nofib and the testsuite performance tests. A full summary of these measurements are found in the description of !2608 Comparing executable sizes (relative to the base commit) across all nofib tests, we see that sizes are similar to the baseline: gmean min max median thresh 50 -6.36% -7.04% -4.82% -6.46% 60 -5.04% -5.97% -3.83% -5.11% 70 -2.90% -3.84% -2.31% -2.92% 80 -0.75% -2.16% -0.42% -0.73% 90 +0.24% -0.41% +0.55% +0.26% 100 +1.36% +0.80% +1.64% +1.37% baseline +0.00% +0.00% +0.00% +0.00% Likewise, looking at runtime allocations we see that 80 gives slightly better optimisation than the baseline: gmean min max median thresh 50 +0.16% -0.16% +4.43% +0.00% 60 +0.09% -0.00% +3.10% +0.00% 70 +0.04% -0.09% +2.29% +0.00% 80 +0.02% -1.17% +2.29% +0.00% 90 -0.02% -2.59% +1.86% +0.00% 100 +0.00% -2.59% +7.51% -0.00% baseline +0.00% +0.00% +0.00% +0.00% Finally, I had to add a NOINLINE in T4306 to ensure that `upd` is worker-wrappered as the test expects. This makes me wonder whether the inlining heuristic is now too liberal as `upd` is quite a large function. The same measure was taken in T12600. Wall clock time compiling Cabal with -O0 thresh 50 60 70 80 90 100 baseline build-Cabal 93.88 89.58 92.59 90.09 100.26 94.81 89.13 Also, this change happens to avoid the spurious test output in `plugin-recomp-change` and `plugin-recomp-change-prof` (see #17308). Metric Decrease: hie002 T12234 T13035 T13719 T14683 T4801 T5631 T5642 T9020 T9872d T9961 Metric Increase: T12150 T12425 T13701 T14697 T15426 T1969 T3064 T5837 T6048 T9203 T9872a T9872b T9872c T9872d haddock.Cabal haddock.base haddock.compiler - - - - - 255418da by Sylvain Henry at 2020-04-07T18:36:49-04:00 Modules: type-checker (#13009) Update Haddock submodule - - - - - 04b6cf94 by Ryan Scott at 2020-04-07T19:43:20-04:00 Make NoExtCon fields strict This changes every unused TTG extension constructor to be strict in its field so that the pattern-match coverage checker is smart enough any such constructors are unreachable in pattern matches. This lets us remove nearly every use of `noExtCon` in the GHC API. The only ones we cannot remove are ones underneath uses of `ghcPass`, but that is only because GHC 8.8's and 8.10's coverage checkers weren't smart enough to perform this kind of reasoning. GHC HEAD's coverage checker, on the other hand, _is_ smart enough, so we guard these uses of `noExtCon` with CPP for now. Bumps the `haddock` submodule. Fixes #17992. - - - - - 7802fa17 by Ryan Scott at 2020-04-08T16:43:44-04:00 Handle promoted data constructors in typeToLHsType correctly Instead of using `nlHsTyVar`, which hardcodes `NotPromoted`, have `typeToLHsType` pick between `Promoted` and `NotPromoted` by checking if a type constructor is promoted using `isPromotedDataCon`. Fixes #18020. - - - - - ce481361 by Ben Gamari at 2020-04-09T16:17:21-04:00 hadrian: Use --export-dynamic when linking iserv As noticed in #17962, the make build system currently does this (see 3ce0e0ba) but the change was never ported to Hadrian. - - - - - fa66f143 by Ben Gamari at 2020-04-09T16:17:21-04:00 iserv: Don't pass --export-dynamic on FreeBSD This is definitely a hack but it's probably the best we can do for now. Hadrian does the right thing here by passing --export-dynamic only to the linker. - - - - - 39075176 by Ömer Sinan Ağacan at 2020-04-09T16:18:00-04:00 Fix CNF handling in compacting GC Fixes #17937 Previously compacting GC simply ignored CNFs. This is mostly fine as most (see "What about small compacts?" below) CNF objects don't have outgoing pointers, and are "large" (allocated in large blocks) and large objects are not moved or compacted. However if we do GC *during* sharing-preserving compaction then the CNF will have a hash table mapping objects that have been moved to the CNF to their location in the CNF, to be able to preserve sharing. This case is handled in the copying collector, in `scavenge_compact`, where we evacuate hash table entries and then rehash the table. Compacting GC ignored this case. We now visit CNFs in all generations when threading pointers to the compacted heap and thread hash table keys. A visited CNF is added to the list `nfdata_chain`. After compaction is done, we re-visit the CNFs in that list and rehash the tables. The overhead is minimal: the list is static in `Compact.c`, and link field is added to `StgCompactNFData` closure. Programs that don't use CNFs should not be affected. To test this CNF tests are now also run in a new way 'compacting_gc', which just passes `-c` to the RTS, enabling compacting GC for the oldest generation. Before this patch the result would be: Unexpected failures: compact_gc.run compact_gc [bad exit code (139)] (compacting_gc) compact_huge_array.run compact_huge_array [bad exit code (1)] (compacting_gc) With this patch all tests pass. I can also pass `-c -DS` without any failures. What about small compacts? Small CNFs are still not handled by the compacting GC. However so far I'm unable to write a test that triggers a runtime panic ("update_fwd: unknown/strange object") by allocating a small CNF in a compated heap. It's possible that I'm missing something and it's not possible to have a small CNF. NoFib Results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS +0.1% 0.0% 0.0% +0.0% +0.0% CSD +0.1% 0.0% 0.0% 0.0% 0.0% FS +0.1% 0.0% 0.0% 0.0% 0.0% S +0.1% 0.0% 0.0% 0.0% 0.0% VS +0.1% 0.0% 0.0% 0.0% 0.0% VSD +0.1% 0.0% +0.0% +0.0% -0.0% VSM +0.1% 0.0% +0.0% -0.0% 0.0% anna +0.0% 0.0% -0.0% -0.0% -0.0% ansi +0.1% 0.0% +0.0% +0.0% +0.0% atom +0.1% 0.0% +0.0% +0.0% +0.0% awards +0.1% 0.0% +0.0% +0.0% +0.0% banner +0.1% 0.0% +0.0% +0.0% +0.0% bernouilli +0.1% 0.0% 0.0% -0.0% +0.0% binary-trees +0.1% 0.0% -0.0% -0.0% 0.0% boyer +0.1% 0.0% +0.0% +0.0% +0.0% boyer2 +0.1% 0.0% +0.0% +0.0% +0.0% bspt +0.1% 0.0% -0.0% -0.0% -0.0% cacheprof +0.1% 0.0% -0.0% -0.0% -0.0% calendar +0.1% 0.0% +0.0% +0.0% +0.0% cichelli +0.1% 0.0% +0.0% +0.0% +0.0% circsim +0.1% 0.0% +0.0% +0.0% +0.0% clausify +0.1% 0.0% -0.0% +0.0% +0.0% comp_lab_zift +0.1% 0.0% +0.0% +0.0% +0.0% compress +0.1% 0.0% +0.0% +0.0% 0.0% compress2 +0.1% 0.0% -0.0% 0.0% 0.0% constraints +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm1 +0.1% 0.0% +0.0% +0.0% +0.0% cryptarithm2 +0.1% 0.0% +0.0% +0.0% +0.0% cse +0.1% 0.0% +0.0% +0.0% +0.0% digits-of-e1 +0.1% 0.0% +0.0% -0.0% -0.0% digits-of-e2 +0.1% 0.0% -0.0% -0.0% -0.0% dom-lt +0.1% 0.0% +0.0% +0.0% +0.0% eliza +0.1% 0.0% +0.0% +0.0% +0.0% event +0.1% 0.0% +0.0% +0.0% +0.0% exact-reals +0.1% 0.0% +0.0% +0.0% +0.0% exp3_8 +0.1% 0.0% +0.0% -0.0% 0.0% expert +0.1% 0.0% +0.0% +0.0% +0.0% fannkuch-redux +0.1% 0.0% -0.0% 0.0% 0.0% fasta +0.1% 0.0% -0.0% +0.0% +0.0% fem +0.1% 0.0% -0.0% +0.0% 0.0% fft +0.1% 0.0% -0.0% +0.0% +0.0% fft2 +0.1% 0.0% +0.0% +0.0% +0.0% fibheaps +0.1% 0.0% +0.0% +0.0% +0.0% fish +0.1% 0.0% +0.0% +0.0% +0.0% fluid +0.0% 0.0% +0.0% +0.0% +0.0% fulsom +0.1% 0.0% -0.0% +0.0% 0.0% gamteb +0.1% 0.0% +0.0% +0.0% 0.0% gcd +0.1% 0.0% +0.0% +0.0% +0.0% gen_regexps +0.1% 0.0% -0.0% +0.0% 0.0% genfft +0.1% 0.0% +0.0% +0.0% +0.0% gg +0.1% 0.0% 0.0% +0.0% +0.0% grep +0.1% 0.0% -0.0% +0.0% +0.0% hidden +0.1% 0.0% +0.0% -0.0% 0.0% hpg +0.1% 0.0% -0.0% -0.0% -0.0% ida +0.1% 0.0% +0.0% +0.0% +0.0% infer +0.1% 0.0% +0.0% 0.0% -0.0% integer +0.1% 0.0% +0.0% +0.0% +0.0% integrate +0.1% 0.0% -0.0% -0.0% -0.0% k-nucleotide +0.1% 0.0% +0.0% +0.0% 0.0% kahan +0.1% 0.0% +0.0% +0.0% +0.0% knights +0.1% 0.0% -0.0% -0.0% -0.0% lambda +0.1% 0.0% +0.0% +0.0% -0.0% last-piece +0.1% 0.0% +0.0% 0.0% 0.0% lcss +0.1% 0.0% +0.0% +0.0% 0.0% life +0.1% 0.0% -0.0% +0.0% +0.0% lift +0.1% 0.0% +0.0% +0.0% +0.0% linear +0.1% 0.0% -0.0% +0.0% 0.0% listcompr +0.1% 0.0% +0.0% +0.0% +0.0% listcopy +0.1% 0.0% +0.0% +0.0% +0.0% maillist +0.1% 0.0% +0.0% -0.0% -0.0% mandel +0.1% 0.0% +0.0% +0.0% 0.0% mandel2 +0.1% 0.0% +0.0% +0.0% +0.0% mate +0.1% 0.0% +0.0% 0.0% +0.0% minimax +0.1% 0.0% -0.0% 0.0% -0.0% mkhprog +0.1% 0.0% +0.0% +0.0% +0.0% multiplier +0.1% 0.0% +0.0% 0.0% 0.0% n-body +0.1% 0.0% +0.0% +0.0% +0.0% nucleic2 +0.1% 0.0% +0.0% +0.0% +0.0% para +0.1% 0.0% 0.0% +0.0% +0.0% paraffins +0.1% 0.0% +0.0% -0.0% 0.0% parser +0.1% 0.0% -0.0% -0.0% -0.0% parstof +0.1% 0.0% +0.0% +0.0% +0.0% pic +0.1% 0.0% -0.0% -0.0% 0.0% pidigits +0.1% 0.0% +0.0% -0.0% -0.0% power +0.1% 0.0% +0.0% +0.0% +0.0% pretty +0.1% 0.0% -0.0% -0.0% -0.1% primes +0.1% 0.0% -0.0% -0.0% -0.0% primetest +0.1% 0.0% -0.0% -0.0% -0.0% prolog +0.1% 0.0% -0.0% -0.0% -0.0% puzzle +0.1% 0.0% -0.0% -0.0% -0.0% queens +0.1% 0.0% +0.0% +0.0% +0.0% reptile +0.1% 0.0% -0.0% -0.0% +0.0% reverse-complem +0.1% 0.0% +0.0% 0.0% -0.0% rewrite +0.1% 0.0% -0.0% -0.0% -0.0% rfib +0.1% 0.0% +0.0% +0.0% +0.0% rsa +0.1% 0.0% -0.0% +0.0% -0.0% scc +0.1% 0.0% -0.0% -0.0% -0.1% sched +0.1% 0.0% +0.0% +0.0% +0.0% scs +0.1% 0.0% +0.0% +0.0% +0.0% simple +0.1% 0.0% -0.0% -0.0% -0.0% solid +0.1% 0.0% +0.0% +0.0% +0.0% sorting +0.1% 0.0% -0.0% -0.0% -0.0% spectral-norm +0.1% 0.0% +0.0% +0.0% +0.0% sphere +0.1% 0.0% -0.0% -0.0% -0.0% symalg +0.1% 0.0% -0.0% -0.0% -0.0% tak +0.1% 0.0% +0.0% +0.0% +0.0% transform +0.1% 0.0% +0.0% +0.0% +0.0% treejoin +0.1% 0.0% +0.0% -0.0% -0.0% typecheck +0.1% 0.0% +0.0% +0.0% +0.0% veritas +0.0% 0.0% +0.0% +0.0% +0.0% wang +0.1% 0.0% 0.0% +0.0% +0.0% wave4main +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve1 +0.1% 0.0% +0.0% +0.0% +0.0% wheel-sieve2 +0.1% 0.0% +0.0% +0.0% +0.0% x2n1 +0.1% 0.0% +0.0% +0.0% +0.0% -------------------------------------------------------------------------------- Min +0.0% 0.0% -0.0% -0.0% -0.1% Max +0.1% 0.0% +0.0% +0.0% +0.0% Geometric Mean +0.1% -0.0% -0.0% -0.0% -0.0% Bumping numbers of nonsensical perf tests: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 It's simply not possible for this patch to increase allocations, and I've wasted enough time on these test in the past (see #17686). I think these tests should not be perf tests, but for now I'll bump the numbers. - - - - - dce50062 by Sylvain Henry at 2020-04-09T16:18:44-04:00 Rts: show errno on failure (#18033) - - - - - 045139f4 by Hécate at 2020-04-09T23:10:44-04:00 Add an example to liftIO and explain its purpose - - - - - 101fab6e by Sebastian Graf at 2020-04-09T23:11:21-04:00 Special case `isConstraintKindCon` on `AlgTyCon` Previously, the `tyConUnique` record selector would unfold into a huge case expression that would be inlined in all call sites, such as the `INLINE`-annotated `coreView`, see #18026. `constraintKindTyConKey` only occurs as the `Unique` of an `AlgTyCon` anyway, so we can make the code a lot more compact, but have to move it to GHC.Core.TyCon. Metric Decrease: T12150 T12234 - - - - - f5212dfc by Sebastian Graf at 2020-04-09T23:11:57-04:00 DmdAnal: No need to attach a StrictSig to DataCon workers In GHC.Types.Id.Make we were giving a strictness signature to every data constructor wrapper Id that we weren't looking at in demand analysis anyway. We used to use its CPR info, but that has its own CPR signature now. `Note [Data-con worker strictness]` then felt very out of place, so I moved it to GHC.Core.DataCon. - - - - - 75a185dc by Sylvain Henry at 2020-04-09T23:12:37-04:00 Hadrian: fix --summary - - - - - 723062ed by Ömer Sinan Ağacan at 2020-04-10T09:18:14+03:00 testsuite: Move no_lint to the top level, tweak hie002 - We don't want to benchmark linting so disable lints in hie002 perf test - Move no_lint to the top-level to be able to use it in tests other than those in `testsuite/tests/perf/compiler`. - Filter out -dstg-lint in no_lint. - hie002 allocation numbers on 32-bit are unstable, so skip it on 32-bit Metric Decrease: hie002 ManyConstructors T12150 T12234 T13035 T1969 T4801 T9233 T9961 - - - - - bcafaa82 by Peter Trommler at 2020-04-10T19:29:33-04:00 Testsuite: mark T11531 fragile The test depends on a link editor allowing undefined symbols in an ELF shared object. This is the standard but it seems some distributions patch their link editor. See the report by @hsyl20 in #11531. Fixes #11531 - - - - - 0889f5ee by Takenobu Tani at 2020-04-12T11:44:52+09:00 testsuite: Fix comment for a language extension [skip ci] - - - - - cd4f92b5 by Simon Peyton Jones at 2020-04-12T11:20:58-04:00 Significant refactor of Lint This refactoring of Lint was triggered by #17923, which is fixed by this patch. The main change is this. Instead of lintType :: Type -> LintM LintedKind we now have lintType :: Type -> LintM LintedType Previously, all of typeKind was effectively duplicate in lintType. Moreover, since we have an ambient substitution, we still had to apply the substition here and there, sometimes more than once. It was all very tricky, in the end, and made my head hurt. Now, lintType returns a fully linted type, with all substitutions performed on it. This is much simpler. The same thing is needed for Coercions. Instead of lintCoercion :: OutCoercion -> LintM (LintedKind, LintedKind, LintedType, LintedType, Role) we now have lintCoercion :: Coercion -> LintM LintedCoercion Much simpler! The code is shorter and less bug-prone. There are a lot of knock on effects. But life is now better. Metric Decrease: T1969 - - - - - 0efaf301 by Josh Meredith at 2020-04-12T11:21:34-04:00 Implement extensible interface files - - - - - 54ca66a7 by Ryan Scott at 2020-04-12T11:22:10-04:00 Use conLikeUserTyVarBinders to quantify field selector types This patch: 1. Writes up a specification for how the types of top-level field selectors should be determined in a new section of the GHC User's Guide, and 2. Makes GHC actually implement that specification by using `conLikeUserTyVarBinders` in `mkOneRecordSelector` to preserve the order and specificity of type variables written by the user. Fixes #18023. - - - - - 35799dda by Ben Gamari at 2020-04-12T11:22:50-04:00 hadrian: Don't --export-dynamic on Darwin When fixing #17962 I neglected to consider that --export-dynamic is only supported on ELF platforms. - - - - - e8029816 by Alexis King at 2020-04-12T11:23:27-04:00 Add an INLINE pragma to Control.Category.>>> This fixes #18013 by adding INLINE pragmas to both Control.Category.>>> and GHC.Desugar.>>>. The functional change in this patch is tiny (just two lines of pragmas!), but an accompanying Note explains in gory detail what’s going on. - - - - - 0da186c1 by Krzysztof Gogolewski at 2020-04-14T07:55:20-04:00 Change zipWith to zipWithEqual in a few places - - - - - 074c1ccd by Andreas Klebinger at 2020-04-14T07:55:55-04:00 Small change to the windows ticker. We already have a function to go from time to ms so use it. Also expand on the state of timer resolution. - - - - - b69cc884 by Alp Mestanogullari at 2020-04-14T07:56:38-04:00 hadrian: get rid of unnecessary levels of nesting in source-dist - - - - - d0c3b069 by Julien Debon at 2020-04-14T07:57:16-04:00 doc (Foldable): Add examples to Data.Foldable See #17929 - - - - - 5b08e0c0 by Ben Gamari at 2020-04-14T23:28:20-04:00 StgCRun: Enable unwinding only on Linux It's broken on macOS due and SmartOS due to assembler differences (#15207) so let's be conservative in enabling it. Also, refactor things to make the intent clearer. - - - - - 27cc2e7b by Ben Gamari at 2020-04-14T23:28:57-04:00 rts: Don't mark evacuate_large as inline This function has two callsites and is quite large. GCC consequently decides not to inline and warns instead. Given the situation, I can't blame it. Let's just remove the inline specifier. - - - - - 9853fc5e by Ben Gamari at 2020-04-14T23:29:48-04:00 base: Enable large file support for OFD locking impl. Not only is this a good idea in general but this should also avoid issue #17950 by ensuring that off_t is 64-bits. - - - - - 7b41f21b by Matthew Pickering at 2020-04-14T23:30:24-04:00 Hadrian: Make -i paths absolute The primary reason for this change is that ghcide does not work with relative paths. It also matches what cabal and stack do, they always pass absolute paths. - - - - - 41230e26 by Daniel Gröber at 2020-04-14T23:31:01-04:00 Zero out pinned block alignment slop when profiling The heap profiler currently cannot traverse pinned blocks because of alignment slop. This used to just be a minor annoyance as the whole block is accounted into a special cost center rather than the respective object's CCS, cf. #7275. However for the new root profiler we would like to be able to visit _every_ closure on the heap. We need to do this so we can get rid of the current 'flip' bit hack in the heap traversal code. Since info pointers are always non-zero we can in principle skip all the slop in the profiler if we can rely on it being zeroed. This assumption caused problems in the past though, commit a586b33f8e ("rts: Correct handling of LARGE ARR_WORDS in LDV profiler"), part of !1118, tried to use the same trick for BF_LARGE objects but neglected to take into account that shrink*Array# functions don't ensure that slop is zeroed when not compiling with profiling. Later, commit 0c114c6599 ("Handle large ARR_WORDS in heap census (fix as we will only be assuming slop is zeroed when profiling is on. This commit also reduces the ammount of slop we introduce in the first place by calculating the needed alignment before doing the allocation for small objects where we know the next available address. For large objects we don't know how much alignment we'll have to do yet since those details are hidden behind the allocateMightFail function so there we continue to allocate the maximum additional words we'll need to do the alignment. So we don't have to duplicate all this logic in the cmm code we pull it into the RTS allocatePinned function instead. Metric Decrease: T7257 haddock.Cabal haddock.base - - - - - 15fa9bd6 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Expand and add more notes regarding slop - - - - - caf3f444 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: allocatePinned: Fix confusion about word/byte units - - - - - c3c0f662 by Daniel Gröber at 2020-04-14T23:31:01-04:00 rts: Underline some Notes as is conventional - - - - - e149dea9 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Fix nomenclature in OVERWRITING_CLOSURE macros The additional commentary introduced by commit 8916e64e5437 ("Implement shrinkSmallMutableArray# and resizeSmallMutableArray#.") unfortunately got this wrong. We set 'prim' to true in overwritingClosureOfs because we _don't_ want to call LDV_recordDead(). The reason is because of this "inherently used" distinction made in the LDV profiler so I rename the variable to be more appropriate. - - - - - 1dd3d18c by Daniel Gröber at 2020-04-14T23:31:38-04:00 Remove call to LDV_RECORD_CREATE for array resizing - - - - - 19de2fb0 by Daniel Gröber at 2020-04-14T23:31:38-04:00 rts: Assert LDV_recordDead is not called for inherently used closures The comments make it clear LDV_recordDead should not be called for inhererently used closures, so add an assertion to codify this fact. - - - - - 0b934e30 by Ryan Scott at 2020-04-14T23:32:14-04:00 Bump template-haskell version to 2.17.0.0 This requires bumping the `exceptions` and `text` submodules to bring in commits that bump their respective upper version bounds on `template-haskell`. Fixes #17645. Fixes #17696. Note that the new `text` commit includes a fair number of additions to the Haddocks in that library. As a result, Haddock has to do more work during the `haddock.Cabal` test case, increasing the number of allocations it requires. Therefore, ------------------------- Metric Increase: haddock.Cabal ------------------------- - - - - - 22cc8e51 by Ryan Scott at 2020-04-15T17:48:47-04:00 Fix #18052 by using pprPrefixOcc in more places This fixes several small oversights in the choice of pretty-printing function to use. Fixes #18052. - - - - - ec77b2f1 by Daniel Gröber at 2020-04-15T17:49:24-04:00 rts: ProfHeap: Fix wrong time in last heap profile sample We've had this longstanding issue in the heap profiler, where the time of the last sample in the profile is sometimes way off causing the rendered graph to be quite useless for long runs. It seems to me the problem is that we use mut_user_time() for the last sample as opposed to getRTSStats(), which we use when calling heapProfile() in GC.c. The former is equivalent to getProcessCPUTime() but the latter does some additional stuff: getProcessCPUTime() - end_init_cpu - stats.gc_cpu_ns - stats.nonmoving_gc_cpu_ns So to fix this just use getRTSStats() in both places. - - - - - 85fc32f0 by Sylvain Henry at 2020-04-17T12:45:25-04:00 Hadrian: fix dyn_o/dyn_hi rule (#17534) - - - - - bfde3b76 by Ryan Scott at 2020-04-17T12:46:02-04:00 Fix #18065 by fixing an InstCo oversight in Core Lint There was a small thinko in Core Lint's treatment of `InstCo` coercions that ultimately led to #18065. The fix: add an apostrophe. That's it! Fixes #18065. Co-authored-by: Simon Peyton Jones <simonpj at microsoft.com> - - - - - a05348eb by Cale Gibbard at 2020-04-17T13:08:47-04:00 Change the fail operator argument of BindStmt to be a Maybe Don't use noSyntaxExpr for it. There is no good way to defensively case on that, nor is it clear one ought to do so. - - - - - 79e27144 by John Ericson at 2020-04-17T13:08:47-04:00 Use trees that grow for rebindable operators for `<-` binds Also add more documentation. - - - - - 18bc16ed by Cale Gibbard at 2020-04-17T13:08:47-04:00 Use FailOperator in more places, define a couple datatypes (XBindStmtRn and XBindStmtTc) to help clarify the meaning of XBindStmt in the renamer and typechecker - - - - - 84cc8394 by Simon Peyton Jones at 2020-04-18T13:20:29-04:00 Add a missing zonk in tcHsPartialType I omitted a vital zonk when refactoring tcHsPartialType in commit 48fb3482f8cbc8a4b37161021e846105f980eed4 Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Wed Jun 5 08:55:17 2019 +0100 Fix typechecking of partial type signatures This patch fixes it and adds commentary to explain why. Fixes #18008 - - - - - 2ee96ac1 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Bump FreeBSD bootstrap compiler to 8.10.1 - - - - - 434312e5 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Enable FreeBSD job for so-labelled MRs - - - - - ddffb227 by Ben Gamari at 2020-04-18T13:21:05-04:00 gitlab-ci: Use rules syntax for conditional jobs - - - - - e2586828 by Ben Gamari at 2020-04-18T13:21:05-04:00 Bump hsc2hs submodule - - - - - 15ab6cd5 by Ömer Sinan Ağacan at 2020-04-18T13:21:44-04:00 Improve prepForeignCall error reporting Show parameters and description of the error code when ffi_prep_cif fails. This may be helpful for debugging #17018. - - - - - 3ca52151 by Sylvain Henry at 2020-04-18T20:04:14+02:00 GHC.Core.Opt renaming * GHC.Core.Op => GHC.Core.Opt * GHC.Core.Opt.Simplify.Driver => GHC.Core.Opt.Driver * GHC.Core.Opt.Tidy => GHC.Core.Tidy * GHC.Core.Opt.WorkWrap.Lib => GHC.Core.Opt.WorkWrap.Utils As discussed in: * https://mail.haskell.org/pipermail/ghc-devs/2020-April/018758.html * https://gitlab.haskell.org/ghc/ghc/issues/13009#note_264650 - - - - - 15312bbb by Sylvain Henry at 2020-04-18T20:04:46+02:00 Modules (#13009) * SysTools * Parser * GHC.Builtin * GHC.Iface.Recomp * Settings Update Haddock submodule Metric Decrease: Naperian parsing001 - - - - - eaed0a32 by Alexis King at 2020-04-19T03:16:44-04:00 Add missing addInScope call for letrec binders in OccurAnal This fixes #18044, where a shadowed variable was incorrectly substituted by the binder swap on the RHS of a floated-in letrec. This can only happen when the uniques line up *just* right, so writing a regression test would be very difficult, but at least the fix is small and straightforward. - - - - - 36882493 by Shayne Fletcher at 2020-04-20T04:36:43-04:00 Derive Ord instance for Extension Metric Increase: T12150 T12234 - - - - - b43365ad by Simon Peyton Jones at 2020-04-20T04:37:20-04:00 Fix a buglet in redundant-constraint warnings Ticket #18036 pointed out that we were reporting a redundant constraint when it really really wasn't. Turned out to be a buglet in the SkolemInfo for the relevant implication constraint. Easily fixed! - - - - - d5fae7da by Ömer Sinan Ağacan at 2020-04-20T14:39:28-04:00 Mark T12010 fragile on 32-bit - - - - - bca02fca by Adam Sandberg Ericsson at 2020-04-21T06:38:45-04:00 docs: drop note about not supporting shared libraries on unix systems [skip ci] - - - - - 6655f933 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Use ParserFlags in GHC.Runtime.Eval (#17957) Instead of passing `DynFlags` to functions such as `isStmt` and `hasImport` in `GHC.Runtime.Eval` we pass `ParserFlags`. It's a much simpler structure that can be created purely with `mkParserFlags'`. - - - - - 70be0fbc by Sylvain Henry at 2020-04-21T06:39:32-04:00 GHC.Runtime: avoid DynFlags (#17957) * add `getPlatform :: TcM Platform` helper * remove unused `DynFlags` parameter from `emptyPLS` - - - - - 35e43d48 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid DynFlags in Ppr code (#17957) * replace `DynFlags` parameters with `SDocContext` parameters for a few Ppr related functions: `bufLeftRenderSDoc`, `printSDoc`, `printSDocLn`, `showSDocOneLine`. * remove the use of `pprCols :: DynFlags -> Int` in Outputable. We already have the information via `sdocLineLength :: SDocContext -> Int` - - - - - ce5c2999 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid using sdocWithDynFlags (#17957) Remove one use of `sdocWithDynFlags` from `GHC.CmmToLlvm.llvmCodeGen'` and from `GHC.Driver.CodeOutput.profilingInitCode` - - - - - f2a98996 by Sylvain Henry at 2020-04-21T06:39:32-04:00 Avoid `sdocWithDynFlags` in `pprCLbl` (#17957) * add a `DynFlags` parameter to `pprCLbl` * put `maybe_underscore` and `pprAsmCLbl` in a `where` clause to avoid `DynFlags` parameters - - - - - 747093b7 by Sylvain Henry at 2020-04-21T06:39:32-04:00 CmmToAsm DynFlags refactoring (#17957) * Remove `DynFlags` parameter from `isDynLinkName`: `isDynLinkName` used to test the global `ExternalDynamicRefs` flag. Now we test it outside of `isDynLinkName` * Add new fields into `NCGConfig`: current unit id, sse/bmi versions, externalDynamicRefs, etc. * Replace many uses of `DynFlags` by `NCGConfig` * Moved `BMI/SSE` datatypes into `GHC.Platform` - - - - - ffd7eef2 by Takenobu Tani at 2020-04-22T23:09:50-04:00 stg-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Stg/Syntax.hs <= stgSyn/StgSyn.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/CostCentre.hs <= profiling/CostCentre.hs This patch also updates old file path [2]: * utils/genapply/Main.hs <= utils/genapply/GenApply.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: commit 0cc4aad36f [skip ci] - - - - - e8a5d81b by Jonathan DK Gibbons at 2020-04-22T23:10:28-04:00 Refactor the `MatchResult` type in the desugarer This way, it does a better job of proving whether or not the fail operator is used. - - - - - dcb7fe5a by John Ericson at 2020-04-22T23:10:28-04:00 Remove panic in dsHandleMonadicFailure Rework dsHandleMonadicFailure to be correct by construction instead of using an unreachable panic. - - - - - cde23cd4 by John Ericson at 2020-04-22T23:10:28-04:00 Inline `adjustMatchResult` It is just `fmap` - - - - - 72cb6bcc by John Ericson at 2020-04-22T23:10:28-04:00 Generalize type of `matchCanFail` - - - - - 401f7bb3 by John Ericson at 2020-04-22T23:10:28-04:00 `MatchResult'` -> `MatchResult` Inline `MatchResult` alias accordingly. - - - - - 6c9fae23 by Alexis King at 2020-04-22T23:11:12-04:00 Mark DataCon wrappers CONLIKE Now that DataCon wrappers don’t inline until phase 0 (see commit b78cc64e923716ac0512c299f42d4d0012306c05), it’s important that case-of-known-constructor and RULE matching be able to see saturated applications of DataCon wrappers in unfoldings. Making them conlike is a natural way to do it, since they are, in fact, precisely the sort of thing the CONLIKE pragma exists to solve. Fixes #18012. This also bumps the version of the parsec submodule to incorporate a patch that avoids a metric increase on the haddock perf tests. The increase was not really a flaw in this patch, as parsec was implicitly relying on inlining heuristics. The patch to parsec just adds some INLINABLE pragmas, and we get a nice performance bump out of it (well beyond the performance we lost from this patch). Metric Decrease: T12234 WWRec haddock.Cabal haddock.base haddock.compiler - - - - - 48b8951e by Roland Senn at 2020-04-22T23:11:51-04:00 Fix tab-completion for :break (#17989) In tab-completion for the `:break` command, only those identifiers should be shown, that are accepted in the `:break` command. Hence these identifiers must be - defined in an interpreted module - top-level - currently in scope - listed in a `ModBreaks` value as a possible breakpoint. The identifiers my be qualified or unqualified. To get all possible top-level breakpoints for tab-completeion with the correct qualification do: 1. Build the list called `pifsBreaks` of all pairs of (Identifier, module-filename) from the `ModBreaks` values. Here all identifiers are unqualified. 2. Build the list called `pifInscope` of all pairs of (Identifiers, module-filename) with identifiers from the `GlobalRdrEnv`. Take only those identifiers that are in scope and have the correct prefix. Here the identifiers may be qualified. 3. From the `pifInscope` list seclect all pairs that can be found in the `pifsBreaks` list, by comparing only the unqualified part of the identifier. The remaining identifiers can be used for tab-completion. This ensures, that we show only identifiers, that can be used in a `:break` command. - - - - - 34a45ee6 by Peter Trommler at 2020-04-22T23:12:27-04:00 PPC NCG: Add DWARF constants and debug labels Fixes #11261 - - - - - ffde2348 by Simon Peyton Jones at 2020-04-22T23:13:06-04:00 Do eager instantation in terms This patch implements eager instantiation, a small but critical change to the type inference engine, #17173. The main change is this: When inferring types, always return an instantiated type (for now, deeply instantiated; in future shallowly instantiated) There is more discussion in https://www.tweag.io/posts/2020-04-02-lazy-eager-instantiation.html There is quite a bit of refactoring in this patch: * The ir_inst field of GHC.Tc.Utils.TcType.InferResultk has entirely gone. So tcInferInst and tcInferNoInst have collapsed into tcInfer. * Type inference of applications, via tcInferApp and tcInferAppHead, are substantially refactored, preparing the way for Quick Look impredicativity. * New pure function GHC.Tc.Gen.Expr.collectHsArgs and applyHsArgs are beatifully dual. We can see the zipper! * GHC.Tc.Gen.Expr.tcArgs is now much nicer; no longer needs to return a wrapper * In HsExpr, HsTypeApp now contains the the actual type argument, and is used in desugaring, rather than putting it in a mysterious wrapper. * I struggled a bit with good error reporting in Unify.matchActualFunTysPart. It's a little bit simpler than before, but still not great. Some smaller things * Rename tcPolyExpr --> tcCheckExpr tcMonoExpr --> tcLExpr * tcPatSig moves from GHC.Tc.Gen.HsType to GHC.Tc.Gen.Pat Metric Decrease: T9961 Reduction of 1.6% in comiler allocation on T9961, I think. - - - - - 6f84aca3 by Ben Gamari at 2020-04-22T23:13:43-04:00 rts: Ensure that sigaction structs are initialized I noticed these may have uninitialized fields when looking into #18037. The reporter says that zeroing them doesn't fix the MSAN failures they observe but zeroing them is the right thing to do regardless. - - - - - c29f0fa6 by Andreas Klebinger at 2020-04-22T23:14:21-04:00 Add "ddump-cmm-opt" as alias for "ddump-opt-cmm". - - - - - 4b4a8b60 by Ben Gamari at 2020-04-22T23:14:57-04:00 llvmGen: Remove -fast-llvm flag Issue #18076 drew my attention to the undocumented `-fast-llvm` flag for the LLVM code generator introduced in 22733532171330136d87533d523f565f2a4f102f. Speaking to Moritz about this, the motivation for this flag was to avoid potential incompatibilities between LLVM and the assembler/linker toolchain by making LLVM responsible for machine-code generation. Unfortunately, this cannot possibly work: the LLVM backend's mangler performs a number of transforms on the assembler generated by LLVM that are necessary for correctness. These are currently: * mangling Haskell functions' symbol types to be `object` instead of `function` on ELF platforms (necessary for tables-next-to-code) * mangling AVX instructions to ensure that we don't assume alignment (which LLVM otherwise does) * mangling Darwin's subsections-via-symbols directives Given that these are all necessary I don't believe that we can support `-fast-llvm`. Let's rather remove it. - - - - - 831b6642 by Moritz Angermann at 2020-04-22T23:15:33-04:00 Fix build warning; add more informative information to the linker; fix linker for empty sections - - - - - c409961a by Ryan Scott at 2020-04-22T23:16:12-04:00 Update commentary and slightly refactor GHC.Tc.Deriv.Infer There was some out-of-date commentary in `GHC.Tc.Deriv.Infer` that has been modernized. Along the way, I removed the `bad` constraints in `simplifyDeriv`, which did not serve any useful purpose (besides being printed in debugging output). Fixes #18073. - - - - - 125aa2b8 by Ömer Sinan Ağacan at 2020-04-22T23:16:51-04:00 Remove leftover comment in tcRnModule', redundant bind The code for the comment was moved in dc8c03b2a5c but the comment was forgotten. - - - - - 8ea37b01 by Sylvain Henry at 2020-04-22T23:17:34-04:00 RTS: workaround a Linux kernel bug in timerfd Reading a timerfd may return 0: https://lkml.org/lkml/2019/8/16/335. This is currently undocumented behavior and documentation "won't happen anytime soon" (https://lkml.org/lkml/2020/2/13/295). With this patch, we just ignore the result instead of crashing. It may fix #18033 but we can't be sure because we don't have enough information. See also this discussion about the kernel bug: https://github.com/Azure/sonic-swss-common/pull/302/files/1f070e7920c2e5d63316c0105bf4481e73d72dc9 - - - - - cd8409c2 by Ryan Scott at 2020-04-23T11:39:24-04:00 Create di_scoped_tvs for associated data family instances properly See `Note [Associated data family instances and di_scoped_tvs]` in `GHC.Tc.TyCl.Instance`, which explains all of the moving parts. Fixes #18055. - - - - - 339e8ece by Ben Gamari at 2020-04-23T11:40:02-04:00 hadrian/ghci: Allow arguments to be passed to GHCi Previously the arguments passed to hadrian/ghci were passed both to `hadrian` and GHCi. This is rather odd given that there are essentially not arguments in the intersection of the two. Let's just pass them to GHCi; this allows `hadrian/ghci -Werror`. - - - - - 5946c85a by Ben Gamari at 2020-04-23T11:40:38-04:00 testsuite: Don't attempt to read .std{err,out} files if they don't exist Simon reports that he was previously seeing framework failures due to an attempt to read the non-existing T13456.stderr. While I don't know exactly what this is due to, it does seem like a non-existing .std{out,err} file should be equivalent to an empty file. Teach the testsuite driver to treat it as such. - - - - - c42754d5 by John Ericson at 2020-04-23T18:32:43-04:00 Trees That Grow refactor for `ConPat` and `CoPat` - `ConPat{In,Out}` -> `ConPat` - `CoPat` -> `XPat (CoPat ..)` Note that `GHC.HS.*` still uses `HsWrap`, but only when `p ~ GhcTc`. After this change, moving the type family instances out of `GHC.HS.*` is sufficient to break the cycle. Add XCollectPat class to decide how binders are collected from XXPat based on the pass. Previously we did this with IsPass, but that doesn't work for Haddock's DocNameI, and the constraint doesn't express what actual distinction is being made. Perhaps a class for collecting binders more generally is in order, but we haven't attempted this yet. Pure refactor of code around ConPat - InPat/OutPat synonyms removed - rename several identifiers - redundant constraints removed - move extension field in ConPat to be first - make ConPat use record syntax more consistently Fix T6145 (ConPatIn became ConPat) Add comments from SPJ. Add comment about haddock's use of CollectPass. Updates haddock submodule. - - - - - 72da0c29 by mniip at 2020-04-23T18:33:21-04:00 Add :doc to GHC.Prim - - - - - 2c23e2e3 by mniip at 2020-04-23T18:33:21-04:00 Include docs for non-primop entries in primops.txt as well - - - - - 0ac29c88 by mniip at 2020-04-23T18:33:21-04:00 GHC.Prim docs: note and test - - - - - b0fbfc75 by John Ericson at 2020-04-24T12:07:14-04:00 Switch order on `GhcMake.IsBoot` In !1798 we were requested to replace many `Bool`s with this data type. But those bools had `False` meaning `NotBoot`, so the `Ord` instance would be flipped if we use this data-type as-is. Since the planned formally-`Bool` occurrences vastly outnumber the current occurrences, we figured it would be better to conform the `Ord` instance to how the `Bool` is used now, fixing any issues, rather than fix them currently with the bigger refactor later in !1798. That way, !1798 can be a "pure" refactor with no behavioral changes. - - - - - af332442 by Sylvain Henry at 2020-04-26T13:55:14-04:00 Modules: Utils and Data (#13009) Update Haddock submodule Metric Increase: haddock.compiler - - - - - cd4434c8 by Sylvain Henry at 2020-04-26T13:55:16-04:00 Fix misleading Ptr phantom type in SerializedCompact (#15653) - - - - - 22bf5c73 by Ömer Sinan Ağacan at 2020-04-26T13:55:22-04:00 Tweak includes in non-moving GC headers We don't use hash tables in non-moving GC so remove the includes. This breaks Compact.c as existing includes no longer include Hash.h, so include Hash.h explicitly in Compact.c. - - - - - 99823ed2 by Sylvain Henry at 2020-04-27T20:24:46-04:00 TH: fix Show/Eq/Ord instances for Bytes (#16457) We shouldn't compare pointer values but the actual bytes. - - - - - c62271a2 by Alp Mestanogullari at 2020-04-27T20:25:33-04:00 hadrian: always capture both stdout and stderr when running a builder fails The idea being that when a builder('s command) fails, we quite likely want to have all the information available to figure out why. Depending on the builder _and_ the particular problem, the useful bits of information can be printed on stdout or stderr. We accomplish this by defining a simple wrapper for Shake's `cmd` function, that just _always_ captures both streams in case the command returns a non-zero exit code, and by using this wrapper everywhere in `hadrian/src/Builder.hs`. Fixes #18089. - - - - - 4b9764db by Ryan Scott at 2020-04-28T15:40:04-04:00 Define a Quote IO instance Fixes #18103. - - - - - 518a63d4 by Ryan Scott at 2020-04-28T15:40:42-04:00 Make boxed 1-tuples have known keys Unlike other tuples, which use special syntax and are "known" by way of a special `isBuiltInOcc_maybe` code path, boxed 1-tuples do not use special syntax. Therefore, in order to make sure that the internals of GHC are aware of the `data Unit a = Unit a` definition in `GHC.Tuple`, we give `Unit` known keys. For the full details, see `Note [One-tuples] (Wrinkle: Make boxed one-tuple names have known keys)` in `GHC.Builtin.Types`. Fixes #18097. - - - - - 2cfc4ab9 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Document backpack fields in DynFlags - - - - - 10a2ba90 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo * Rename InstalledPackageInfo into GenericUnitInfo The name InstalledPackageInfo is only kept for alleged backward compatibility reason in Cabal. ghc-boot has its own stripped down copy of this datatype but it doesn't need to keep the name. Internally we already use type aliases (UnitInfo in GHC, PackageCacheFormat in ghc-pkg). * Rename UnitInfo fields: add "unit" prefix and fix misleading names * Add comments on every UnitInfo field * Rename SourcePackageId into PackageId "Package" already indicates that it's a "source package". Installed package components are called units. Update Haddock submodule - - - - - 69562e34 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Remove unused `emptyGenericUnitInfo` - - - - - 9e2c8e0e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactor UnitInfo load/store from databases Converting between UnitInfo stored in package databases and UnitInfo as they are used in ghc-pkg and ghc was done in a very convoluted way (via BinaryStringRep and DbUnitModuleRep type classes using fun deps, etc.). It was difficult to understand and even more to modify (I wanted to try to use a GADT for UnitId but fun deps got in the way). The new code uses much more straightforward functions to convert between the different representations. Much simpler. - - - - - ea717aa4 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Factorize mungePackagePaths code This patch factorizes the duplicated code used in ghc-pkg and in GHC to munge package paths/urls. It also fixes haddock-html munging in GHC (allowed to be either a file or a url) to mimic ghc-pkg behavior. - - - - - 10d15f1e by Sylvain Henry at 2020-04-30T01:56:56-04:00 Refactoring unit management code Over the years the unit management code has been modified a lot to keep up with changes in Cabal (e.g. support for several library components in the same package), to integrate BackPack, etc. I found it very hard to understand as the terminology wasn't consistent, was referring to past concepts, etc. The terminology is now explained as clearly as I could in the Note "About Units" and the code is refactored to reflect it. ------------------- Many names were misleading: UnitId is not an Id but could be a virtual unit (an indefinite one instantiated on the fly), IndefUnitId constructor may contain a definite instantiated unit, etc. * Rename IndefUnitId into InstantiatedUnit * Rename IndefModule into InstantiatedModule * Rename UnitId type into Unit * Rename IndefiniteUnitId constructor into VirtUnit * Rename DefiniteUnitId constructor into RealUnit * Rename packageConfigId into mkUnit * Rename getPackageDetails into unsafeGetUnitInfo * Rename InstalledUnitId into UnitId Remove references to misleading ComponentId: a ComponentId is just an indefinite unit-id to be instantiated. * Rename ComponentId into IndefUnitId * Rename ComponentDetails into UnitPprInfo * Fix display of UnitPprInfo with empty version: this is now used for units dynamically generated by BackPack Generalize several types (Module, Unit, etc.) so that they can be used with different unit identifier types: UnitKey, UnitId, Unit, etc. * GenModule: Module, InstantiatedModule and InstalledModule are now instances of this type * Generalize DefUnitId, IndefUnitId, Unit, InstantiatedUnit, PackageDatabase Replace BackPack fake "hole" UnitId by a proper HoleUnit constructor. Add basic support for UnitKey. They should be used more in the future to avoid mixing them up with UnitId as we do now. Add many comments. Update Haddock submodule - - - - - 8bfb0219 by Sylvain Henry at 2020-04-30T01:56:56-04:00 Unit: split and rename modules Introduce GHC.Unit.* hierarchy for everything concerning units, packages and modules. Update Haddock submodule - - - - - 71484b09 by Alexis King at 2020-04-30T01:57:35-04:00 Allow block arguments in arrow control operators Arrow control operators have their own entries in the grammar, so they did not cooperate with BlockArguments. This was just a minor oversight, so this patch adjusts the grammar to add the desired behavior. fixes #18050 - - - - - a48cd2a0 by Alexis King at 2020-04-30T01:57:35-04:00 Allow LambdaCase to be used as a command in proc notation - - - - - f4d3773c by Alexis King at 2020-04-30T01:57:35-04:00 Document BlockArguments/LambdaCase support in arrow notation - - - - - 5bdfdd13 by Simon Peyton Jones at 2020-04-30T01:58:15-04:00 Add tests for #17873 - - - - - 19b701c2 by Simon Peyton Jones at 2020-04-30T07:30:13-04:00 Mark rule args as non-tail-called This was just an omission...b I'd failed to call markAllNonTailCall on rule args. I think this bug has been here a long time, but it's quite hard to trigger. Fixes #18098 - - - - - 014ef4a3 by Matthew Pickering at 2020-04-30T07:30:50-04:00 Hadrian: Improve tool-args command to support more components There is a new command to hadrian, tool:path/to/file.hs, which returns the options needed to compile that file in GHCi. This is now used in the ghci script with argument `ghc/Main.hs` but its main purpose is to support the new multi-component branch of ghcide. - - - - - 2aa67611 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Clear bitmap after initializing block size Previously nonmovingInitSegment would clear the bitmap before initializing the segment's block size. This is broken since nonmovingClearBitmap looks at the segment's block size to determine how much bitmap to clear. - - - - - 54dad3cf by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Explicitly memoize block count A profile cast doubt on whether the compiler hoisted the bound out the loop as I would have expected here. It turns out it did but nevertheless it seems clearer to just do this manually. - - - - - 99ff8145 by Ben Gamari at 2020-04-30T21:34:44-04:00 nonmoving: Eagerly flush all capabilities' update remembered sets (cherry picked from commit 2fa79119570b358a4db61446396889b8260d7957) - - - - - 05b0a9fd by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 Remove OneShotInfo field of LFReEntrant, document OneShotInfo The field is only used in withNewTickyCounterFun and it's easier to directly pass a parameter for one-shot info to withNewTickyCounterFun instead of passing it via LFReEntrant. This also makes !2842 simpler. Other changes: - New Note (by SPJ) [OneShotInfo overview] added. - Arity argument of thunkCode removed as it's always 0. - - - - - a43620c6 by Ömer Sinan Ağacan at 2020-04-30T21:35:24-04:00 GHC.StgToCmm.Ticky: remove a few unused stuff - - - - - 780de9e1 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Use platform in Iface Binary - - - - - f8386c7b by Sylvain Henry at 2020-05-01T10:37:39-04:00 Refactor PprDebug handling If `-dppr-debug` is set, then PprUser and PprDump styles are silently replaced with PprDebug style. This was done in `mkUserStyle` and `mkDumpStyle` smart constructors. As a consequence they needed a DynFlags parameter. Now we keep the original PprUser and PprDump styles until they are used to create an `SDocContext`. I.e. the substitution is only performed in `initSDocContext`. - - - - - b3df9e78 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Remove PprStyle param of logging actions Use `withPprStyle` instead to apply a specific style to a SDoc. - - - - - de9fc995 by Sylvain Henry at 2020-05-01T10:37:39-04:00 Fully remove PprDebug PprDebug was a pain to deal with consistently as it is implied by `-dppr-debug` but it isn't really a PprStyle. We remove it completely and query the appropriate SDoc flag instead (`sdocPprDebug`) via helpers (`getPprDebug` and its friends). - - - - - 8b51fcbd by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Only call checkSingle if we would report warnings - - - - - fd7ea0fe by Sebastian Graf at 2020-05-01T10:38:16-04:00 PmCheck: Pick up `EvVar`s bound in `HsWrapper`s for long-distance info `HsWrapper`s introduce evidence bindings through `WpEvLam` which the pattern-match coverage checker should be made aware of. Failing to do so caused #18049, where the resulting impreciseness of imcompleteness warnings seemingly contradicted with `-Winaccessible-code`. The solution is simple: Collect all the evidence binders of an `HsWrapper` and add it to the ambient `Deltas` before desugaring the wrapped expression. But that means we pick up many more evidence bindings, even when they wrap around code without a single pattern match to check! That regressed `T3064` by over 300%, so now we are adding long-distance info lazily through judicious use of `unsafeInterleaveIO`. Fixes #18049. - - - - - 7bfe9ac5 by Ben Gamari at 2020-05-03T04:41:33-04:00 rts: Enable tracing of nonmoving heap census with -ln Previously this was not easily available to the user. Fix this. Non-moving collection lifecycle events are now reported with -lg. - - - - - c560dd07 by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Move eventlog documentation users guide - - - - - 02543d5e by Ben Gamari at 2020-05-03T04:41:33-04:00 users guide: Add documentation for non-moving GC events - - - - - b465dd45 by Alexis King at 2020-05-03T04:42:12-04:00 Flatten nested casts in the simple optimizer Normally, we aren’t supposed to generated any nested casts, since mkCast takes care to flatten them, but the simple optimizer didn’t use mkCast, so they could show up after inlining. This isn’t really a problem, since the simplifier will clean them up immediately anyway, but it can clutter the -ddump-ds output, and it’s an extremely easy fix. closes #18112 - - - - - 8bdc03d6 by Simon Peyton Jones at 2020-05-04T01:56:59-04:00 Don't return a panic in tcNestedSplice In GHC.Tc.Gen.Splice.tcNestedSplice we were returning a typechecked expression of "panic". That is usually OK, because the result is discarded. But it happens that tcApp now looks at the typechecked expression, trivially, to ask if it is tagToEnum. So being bottom is bad. Moreover a debug-trace might print it out. So better to return a civilised expression, even though it is usually discarded. - - - - - 0bf640b1 by Baldur Blöndal at 2020-05-04T01:57:36-04:00 Don't require parentheses around via type (`-XDerivingVia'). Fixes #18130". - - - - - 30272412 by Artem Pelenitsyn at 2020-05-04T13:19:59-04:00 Remove custom ExceptionMonad class (#18075) (updating haddock submodule accordingly) - - - - - b9f7c08f by jneira at 2020-05-04T13:20:37-04:00 Remove unused hs-boot file - - - - - 1d8f80cd by Sylvain Henry at 2020-05-05T03:22:46-04:00 Remove references to -package-key * remove references to `-package-key` which has been removed in 2016 (240ddd7c39536776e955e881d709bbb039b48513) * remove support for `-this-package-key` which has been deprecated at the same time - - - - - 7bc3a65b by Sylvain Henry at 2020-05-05T03:23:31-04:00 Remove SpecConstrAnnotation (#13681) This has been deprecated since 2013. Use GHC.Types.SPEC instead. Make GHC.Exts "not-home" for haddock Metric Decrease: haddock.base - - - - - 3c862f63 by DenisFrezzato at 2020-05-05T03:24:15-04:00 Fix Haskell98 short description in documentation - - - - - 2420c555 by Ryan Scott at 2020-05-05T03:24:53-04:00 Add regression tests for #16244, #16245, #16758 Commit e3c374cc5bd7eb49649b9f507f9f7740697e3f70 ended up fixing quite a few bugs: * This commit fixes #16244 completely. A regression test has been added. * This commit fixes one program from #16245. (The program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211369 still panics, and the program in https://gitlab.haskell.org/ghc/ghc/issues/16245#note_211400 still loops infinitely.) A regression test has been added for this program. * This commit fixes #16758. Accordingly, this patch removes the `expect_broken` label from the `T16758` test case, moves it from `should_compile` to `should_fail` (as it should produce an error message), and checks in the expected stderr. - - - - - 40c71c2c by Sylvain Henry at 2020-05-05T03:25:31-04:00 Fix colorized error messages (#18128) In b3df9e780fb2f5658412c644849cd0f1e6f50331 I broke colorized messages by using "dump" style instead of "user" style. This commits fixes it. - - - - - 7ab6ab09 by Richard Eisenberg at 2020-05-06T04:39:32-04:00 Refactor hole constraints. Previously, holes (both expression holes / out of scope variables and partial-type-signature wildcards) were emitted as *constraints* via the CHoleCan constructor. While this worked fine for error reporting, there was a fair amount of faff in keeping these constraints in line. In particular, and unlike other constraints, we could never change a CHoleCan to become CNonCanonical. In addition: * the "predicate" of a CHoleCan constraint was really the type of the hole, which is not a predicate at all * type-level holes (partial type signature wildcards) carried evidence, which was never used * tcNormalise (used in the pattern-match checker) had to create a hole constraint just to extract it again; it was quite messy The new approach is to record holes directly in WantedConstraints. It flows much more nicely now. Along the way, I did some cleaning up of commentary in GHC.Tc.Errors.Hole, which I had a hard time understanding. This was instigated by a future patch that will refactor the way predicates are handled. The fact that CHoleCan's "predicate" wasn't really a predicate is incompatible with that future patch. No test case, because this is meant to be purely internal. It turns out that this change improves the performance of the pattern-match checker, likely because fewer constraints are sloshing about in tcNormalise. I have not investigated deeply, but an improvement is not a surprise here: ------------------------- Metric Decrease: PmSeriesG ------------------------- - - - - - 420b957d by Ben Gamari at 2020-05-06T04:40:08-04:00 rts: Zero block flags with -DZ Block flags are very useful for determining the state of a block. However, some block allocator users don't touch them, leading to misleading values. Ensure that we zero then when zero-on-gc is set. This is safe and makes the flags more useful during debugging. - - - - - 740b3b8d by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix incorrect failed_to_evac value during deadlock gc Previously we would incorrectly set the failed_to_evac flag if we evacuated a value due to a deadlock GC. This would cause us to mark more things as dirty than strictly necessary. It also turned up a nasty but which I will fix next. - - - - - b2d72c75 by Ben Gamari at 2020-05-06T04:40:08-04:00 nonmoving: Fix handling of dirty objects Previously we (incorrectly) relied on failed_to_evac to be "precise". That is, we expected it to only be true if *all* of an object's fields lived outside of the non-moving heap. However, does not match the behavior of failed_to_evac, which is true if *any* of the object's fields weren't promoted (meaning that some others *may* live in the non-moving heap). This is problematic as we skip the non-moving write barrier for dirty objects (which we can only safely do if *all* fields point outside of the non-moving heap). Clearly this arises due to a fundamental difference in the behavior expected of failed_to_evac in the moving and non-moving collector. e.g., in the moving collector it is always safe to conservatively say failed_to_evac=true whereas in the non-moving collector the safe value is false. This issue went unnoticed as I never wrote down the dirtiness invariant enforced by the non-moving collector. We now define this invariant as An object being marked as dirty implies that all of its fields are on the mark queue (or, equivalently, update remembered set). To maintain this invariant we teach nonmovingScavengeOne to push the fields of objects which we fail to evacuate to the update remembered set. This is a simple and reasonably cheap solution and avoids the complexity and fragility that other, more strict alternative invariants would require. All of this is described in a new Note, Note [Dirty flags in the non-moving collector] in NonMoving.c. - - - - - 9f3e6884 by Zubin Duggal at 2020-05-06T04:41:08-04:00 Allow atomic update of NameCache in readHieFile The situation arises in ghcide where multiple different threads may need to update the name cache, therefore with the older interface it could happen that you start reading a hie file with name cache A and produce name cache A + B, but another thread in the meantime updated the namecache to A + C. Therefore if you write the new namecache you will lose the A' updates from the second thread. Updates haddock submodule - - - - - edec6a6c by Ryan Scott at 2020-05-06T04:41:57-04:00 Make isTauTy detect higher-rank contexts Previously, `isTauTy` would only detect higher-rank `forall`s, not higher-rank contexts, which led to some minor bugs observed in #18127. Easily fixed by adding a case for `(FunTy InvisArg _ _)`. Fixes #18127. - - - - - a95e7fe0 by Ömer Sinan Ağacan at 2020-05-06T04:42:39-04:00 ELF linker: increment curSymbol after filling in fields of current entry The bug was introduced in a8b7cef4d45 which added a field to the `symbols` array elements and then updated this code incorrectly: - oc->symbols[curSymbol++] = nm; + oc->symbols[curSymbol++].name = nm; + oc->symbols[curSymbol].addr = symbol->addr; - - - - - cab1871a by Sylvain Henry at 2020-05-06T04:43:21-04:00 Move LeadingUnderscore into Platform (#17957) Avoid direct use of DynFlags to know if symbols must be prefixed by an underscore. - - - - - 94e7c563 by Sylvain Henry at 2020-05-06T04:43:21-04:00 Don't use DynFlags in showLinkerState (#17957) - - - - - 9afd9251 by Ryan Scott at 2020-05-06T04:43:58-04:00 Refactoring: Use bindSigTyVarsFV in rnMethodBinds `rnMethodBinds` was explicitly using `xoptM` to determine if `ScopedTypeVariables` is enabled before bringing type variables bound by the class/instance header into scope. However, this `xoptM` logic is already performed by the `bindSigTyVarsFV` function. This patch uses `bindSigTyVarsFV` in `rnMethodBinds` to reduce the number of places where we need to consult if `ScopedTypeVariables` is on. This is purely refactoring, and there should be no user-visible change in behavior. - - - - - 6f6d72b2 by Brian Foley at 2020-05-08T15:29:25-04:00 Remove further dead code found by a simple Python script. Avoid removing some functions that are part of an API even though they're not used in-tree at the moment. - - - - - 78bf8bf9 by Julien Debon at 2020-05-08T15:29:28-04:00 Add doc examples for Bifoldable See #17929 - - - - - 66f0a847 by Julien Debon at 2020-05-08T15:29:29-04:00 doc (Bitraversable): Add examples to Bitraversable * Add examples to Data.Bitraversable * Fix formatting for (,) in Bitraversable and Bifoldable * Fix mistake on bimapAccumR documentation See #17929 - - - - - 9749fe12 by Baldur Blöndal at 2020-05-08T15:29:32-04:00 Specify kind variables for inferred kinds in base. - - - - - 4e9aef9e by John Ericson at 2020-05-08T15:29:36-04:00 HsSigWcTypeScoping: Pull in documentation from stray location - - - - - f4d5c6df by John Ericson at 2020-05-08T15:29:36-04:00 Rename local `real_fvs` to `implicit_vs` It doesn't make sense to call the "free" variables we are about to implicitly bind the real ones. - - - - - 20570b4b by John Ericson at 2020-05-08T15:29:36-04:00 A few tiny style nits with renaming - Use case rather than guards that repeatedly scrutenize same thing. - No need for view pattern when `L` is fine. - Use type synnonym to convey the intent like elsewhere. - - - - - 09ac8de5 by John Ericson at 2020-05-08T15:29:36-04:00 Add `forAllOrNothing` function with note - - - - - bb35c0e5 by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Document lawlessness of Ap's Num instance - - - - - cdd229ff by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply suggestion to libraries/base/Data/Monoid.hs - - - - - 926d2aab by Joseph C. Sible at 2020-05-08T15:29:40-04:00 Apply more suggestions from Simon Jakobi - - - - - 7a763cff by Adam Gundry at 2020-05-08T15:29:41-04:00 Reject all duplicate declarations involving DuplicateRecordFields (fixes #17965) This fixes a bug that resulted in some programs being accepted that used the same identifier as a field label and another declaration, depending on the order they appeared in the source code. - - - - - 88e3c815 by Simon Peyton Jones at 2020-05-08T15:29:41-04:00 Fix specialisation for DFuns When specialising a DFun we must take care to saturate the unfolding. See Note [Specialising DFuns] in Specialise. Fixes #18120 - - - - - 86c77b36 by Greg Steuck at 2020-05-08T15:29:45-04:00 Remove unused SEGMENT_PROT_RWX It's been unused for a year and is problematic on any OS which requires W^X for security. - - - - - 9d97f4b5 by nineonine at 2020-05-08T15:30:03-04:00 Add test for #16167 - - - - - aa318338 by Ryan Scott at 2020-05-08T15:30:04-04:00 Bump exceptions submodule so that dist-boot is .gitignore'd `exceptions` is a stage-0 boot library as of commit 30272412fa437ab8e7a8035db94a278e10513413, which means that building `exceptions` in a GHC tree will generate a `dist-boot` directory. However, this directory was not specified in `exceptions`' `.gitignore` file, which causes it to dirty up the current `git` working directory. Accordingly, this bumps the `exceptions` submodule to commit ghc/packages/exceptions at 23c0b8a50d7592af37ca09beeec16b93080df98f, which adds `dist-boot` to the `.gitignore` file. - - - - - ea86360f by Ömer Sinan Ağacan at 2020-05-08T15:30:30-04:00 Linker.c: initialize n_symbols of ObjectCode with other fields - - - - - 951c1fb0 by Sylvain Henry at 2020-05-09T21:46:38-04:00 Fix unboxed-sums GC ptr-slot rubbish value (#17791) This patch allows boot libraries to use unboxed sums without implicitly depending on `base` package because of `absentSumFieldError`. See updated Note [aBSENT_SUM_FIELD_ERROR_ID] in GHC.Core.Make - - - - - b352d63c by Ben Gamari at 2020-05-09T21:47:14-04:00 rts: Make non-existent linker search path merely a warning As noted in #18105, previously this resulted in a rather intrusive error message. This is in contrast to the general expectation that search paths are merely places to look, not places that must exist. Fixes #18105. - - - - - cf4f1e2f by Ben Gamari at 2020-05-13T02:02:33-04:00 rts/CNF: Fix fixup comparison function Previously we would implicitly convert the difference between two words to an int, resulting in an integer overflow on 64-bit machines. Fixes #16992 - - - - - a03da9bf by Ömer Sinan Ağacan at 2020-05-13T02:03:16-04:00 Pack some of IdInfo fields into a bit field This reduces residency of compiler quite a bit on some programs. Example stats when building T10370: Before: 2,871,242,832 bytes allocated in the heap 4,693,328,008 bytes copied during GC 33,941,448 bytes maximum residency (276 sample(s)) 375,976 bytes maximum slop 83 MiB total memory in use (0 MB lost due to fragmentation) After: 2,858,897,344 bytes allocated in the heap 4,629,255,440 bytes copied during GC 32,616,624 bytes maximum residency (278 sample(s)) 314,400 bytes maximum slop 80 MiB total memory in use (0 MB lost due to fragmentation) So -3.9% residency, -1.3% bytes copied and -0.4% allocations. Fixes #17497 Metric Decrease: T9233 T9675 - - - - - 670c3e5c by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Fix base URL Revert a change previously made for testing purposes. - - - - - 8ad8dc41 by Ben Gamari at 2020-05-13T02:03:54-04:00 get-win32-tarballs: Improve diagnostics output - - - - - 8c0740b7 by Simon Jakobi at 2020-05-13T02:04:33-04:00 docs: Add examples for Data.Semigroup.Arg{Min,Max} Context: #17153 - - - - - cb22348f by Ben Gamari at 2020-05-13T02:05:11-04:00 Add few cleanups of the CAF logic Give the NameSet of non-CAFfy names a proper newtype to distinguish it from all of the other NameSets floating about. - - - - - 90e38b81 by Emeka Nkurumeh at 2020-05-13T02:05:51-04:00 fix printf warning when using with ghc with clang on mingw - - - - - 86d8ac22 by Sebastian Graf at 2020-05-13T02:06:29-04:00 CprAnal: Don't attach CPR sigs to expandable bindings (#18154) Instead, look through expandable unfoldings in `cprTransform`. See the new Note [CPR for expandable unfoldings]: ``` Long static data structures (whether top-level or not) like xs = x1 : xs1 xs1 = x2 : xs2 xs2 = x3 : xs3 should not get CPR signatures, because they * Never get WW'd, so their CPR signature should be irrelevant after analysis (in fact the signature might even be harmful for that reason) * Would need to be inlined/expanded to see their constructed product * Recording CPR on them blows up interface file sizes and is redundant with their unfolding. In case of Nested CPR, this blow-up can be quadratic! But we can't just stop giving DataCon application bindings the CPR property, for example fac 0 = 1 fac n = n * fac (n-1) fac certainly has the CPR property and should be WW'd! But FloatOut will transform the first clause to lvl = 1 fac 0 = lvl If lvl doesn't have the CPR property, fac won't either. But lvl doesn't have a CPR signature to extrapolate into a CPR transformer ('cprTransform'). So instead we keep on cprAnal'ing through *expandable* unfoldings for these arity 0 bindings via 'cprExpandUnfolding_maybe'. In practice, GHC generates a lot of (nested) TyCon and KindRep bindings, one for each data declaration. It's wasteful to attach CPR signatures to each of them (and intractable in case of Nested CPR). ``` Fixes #18154. - - - - - e34bf656 by Ben Gamari at 2020-05-13T02:07:08-04:00 users-guide: Add discussion of shared object naming Fixes #18074. - - - - - 5d0f2445 by Ben Gamari at 2020-05-13T02:07:47-04:00 testsuite: Print sign of performance changes Executes the minor formatting change in the tabulated performance changes suggested in #18135. - - - - - 9e4b981f by Ben Gamari at 2020-05-13T02:08:24-04:00 testsuite: Add testcase for #18129 - - - - - 266310c3 by Ivan-Yudin at 2020-05-13T02:09:03-04:00 doc: Reformulate the opening paragraph of Ch. 4 in User's guide Removes mentioning of Hugs (it is not helpful for new users anymore). Changes the wording for the rest of the paragraph. Fixes #18132. - - - - - 55e35c0b by Baldur Blöndal at 2020-05-13T20:02:48-04:00 Predicate, Equivalence derive via `.. -> a -> All' - - - - - d7e0b57f by Alp Mestanogullari at 2020-05-13T20:03:30-04:00 hadrian: add a --freeze2 option to freeze stage 1 and 2 - - - - - d880d6b2 by Artem Pelenitsyn at 2020-05-13T20:04:11-04:00 Don't reload environment files on every setSessionDynFlags Makes `interpretPackageEnv` (which loads envirinment files) a part of `parseDynamicFlags` (parsing command-line arguments, which is typically done once) instead of `setSessionDynFlags` (which is typically called several times). Making several (transitive) calls to `interpretPackageEnv`, as before, caused #18125 #16318, which should be fixed now. - - - - - 102cfd67 by Ryan Scott at 2020-05-13T20:04:46-04:00 Factor out HsPatSigType for pat sigs/RULE term sigs (#16762) This implements chunks (2) and (3) of https://gitlab.haskell.org/ghc/ghc/issues/16762#note_270170. Namely, it introduces a dedicated `HsPatSigType` AST type, which represents the types that can appear in pattern signatures and term-level `RULE` binders. Previously, these were represented with `LHsSigWcType`. Although `LHsSigWcType` is isomorphic to `HsPatSigType`, the intended semantics of the two types are slightly different, as evidenced by the fact that they have different code paths in the renamer and typechecker. See also the new `Note [Pattern signature binders and scoping]` in `GHC.Hs.Types`. - - - - - b17574f7 by Hécate at 2020-05-13T20:05:28-04:00 fix(documentation): Fix the RST links to GHC.Prim - - - - - df021fb1 by Baldur Blöndal at 2020-05-13T20:06:06-04:00 Document (->) using inferred quantification for its runtime representations. Fixes #18142. - - - - - 1a93ea57 by Takenobu Tani at 2020-05-13T20:06:54-04:00 Tweak man page for ghc command This commit updates the ghc command's man page as followings: * Enable `man_show_urls` to show URL addresses in the `DESCRIPTION` section of ghc.rst, because sphinx currently removes hyperlinks for man pages. * Add a `SEE ALSO` section to point to the GHC homepage - - - - - a951e1ba by Takenobu Tani at 2020-05-13T20:07:37-04:00 GHCi: Add link to the user's guide in help message This commit adds a link to the user's guide in ghci's `:help` message. Newcomers could easily reach to details of ghci. - - - - - 404581ea by Jeff Happily at 2020-05-13T20:08:15-04:00 Handle single unused import - - - - - 1c999e5d by Ben Gamari at 2020-05-13T20:09:07-04:00 Ensure that printMinimalImports closes handle Fixes #18166. - - - - - c9f5a8f4 by Ben Gamari at 2020-05-13T20:09:51-04:00 hadrian: Tell testsuite driver about LLVM availability This reflects the logic present in the Make build system into Hadrian. Fixes #18167. - - - - - c05c0659 by Simon Jakobi at 2020-05-14T03:31:21-04:00 Improve some folds over Uniq[D]FM * Replace some non-deterministic lazy folds with strict folds. * Replace some O(n log n) folds in deterministic order with O(n) non-deterministic folds. * Replace some folds with set-operations on the underlying IntMaps. This reduces max residency when compiling `nofib/spectral/simple/Main.hs` with -O0 by about 1%. Maximum residency when compiling Cabal also seems reduced on the order of 3-9%. - - - - - 477f13bb by Simon Jakobi at 2020-05-14T03:31:58-04:00 Use Data.IntMap.disjoint Data.IntMap gained a dedicated `disjoint` function in containers-0.6.2.1. This patch applies this function where appropriate in hopes of modest compiler performance improvements. Closes #16806. - - - - - e9c0110c by Ben Gamari at 2020-05-14T12:25:53-04:00 IdInfo: Add reference to bitfield-packing ticket - - - - - 9bd20e83 by Sebastian Graf at 2020-05-15T10:42:09-04:00 DmdAnal: Improve handling of precise exceptions This patch does two things: Fix possible unsoundness in what was called the "IO hack" and implement part 2.1 of the "fixing precise exceptions" plan in https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions, which, in combination with !2956, supersedes !3014 and !2525. **IO hack** The "IO hack" (which is a fallback to preserve precise exceptions semantics and thus soundness, rather than some smart thing that increases precision) is called `exprMayThrowPreciseException` now. I came up with two testcases exemplifying possible unsoundness (if twisted enough) in the old approach: - `T13380d`: Demonstrating unsoundness of the "IO hack" when resorting to manual state token threading and direct use of primops. More details below. - `T13380e`: Demonstrating unsoundness of the "IO hack" when we have Nested CPR. Not currently relevant, as we don't have Nested CPR yet. - `T13380f`: Demonstrating unsoundness of the "IO hack" for safe FFI calls. Basically, the IO hack assumed that precise exceptions can only be thrown from a case scrutinee of type `(# State# RealWorld, _ #)`. I couldn't come up with a program using the `IO` abstraction that violates this assumption. But it's easy to do so via manual state token threading and direct use of primops, see `T13380d`. Also similar code might be generated by Nested CPR in the (hopefully not too) distant future, see `T13380e`. Hence, we now have a more careful test in `forcesRealWorld` that passes `T13380{d,e}` (and will hopefully be robust to Nested CPR). **Precise exceptions** In #13380 and #17676 we saw that we didn't preserve precise exception semantics in demand analysis. We fixed that with minimal changes in !2956, but that was terribly unprincipled. That unprincipledness resulted in a loss of precision, which is tracked by these new test cases: - `T13380b`: Regression in dead code elimination, because !2956 was too syntactic about `raiseIO#` - `T13380c`: No need to apply the "IO hack" when the IO action may not throw a precise exception (and the existing IO hack doesn't detect that) Fixing both issues in !3014 turned out to be too complicated and had the potential to regress in the future. Hence we decided to only fix `T13380b` and augment the `Divergence` lattice with a new middle-layer element, `ExnOrDiv`, which means either `Diverges` (, throws an imprecise exception) or throws a *precise* exception. See the wiki page on Step 2.1 for more implementational details: https://gitlab.haskell.org/ghc/ghc/wikis/fixing-precise-exceptions#dead-code-elimination-for-raiseio-with-isdeadenddiv-introducing-exnordiv-step-21 - - - - - 568d7279 by Ben Gamari at 2020-05-15T10:42:46-04:00 GHC.Cmm.Opt: Handle MO_XX_Conv This MachOp was introduced by 2c959a1894311e59cd2fd469c1967491c1e488f3 but a wildcard match in cmmMachOpFoldM hid the fact that it wasn't handled. Ideally we would eliminate the match but this appears to be a larger task. Fixes #18141. - - - - - 5bcf8606 by Ryan Scott at 2020-05-17T08:46:38-04:00 Remove duplicate Note [When to print foralls] in GHC.Core.TyCo.Ppr There are two different Notes named `[When to print foralls]`. The most up-to-date one is in `GHC.Iface.Type`, but there is a second one in `GHC.Core.TyCo.Ppr`. The latter is less up-to-date, as it was written before GHC switched over to using ifaces to pretty-print types. I decided to just remove the latter and replace it with a reference to the former. [ci skip] - - - - - 55f0e783 by Fumiaki Kinoshita at 2020-05-21T12:10:44-04:00 base: Add Generic instances to various datatypes under GHC.* * GHC.Fingerprint.Types: Fingerprint * GHC.RTS.Flags: GiveGCStats, GCFlags, ConcFlags, DebugFlags, CCFlags, DoHeapProfile, ProfFlags, DoTrace, TraceFlags, TickyFlags, ParFlags and RTSFlags * GHC.Stats: RTSStats and GCStats * GHC.ByteOrder: ByteOrder * GHC.Unicode: GeneralCategory * GHC.Stack.Types: SrcLoc Metric Increase: haddock.base - - - - - a9311cd5 by Gert-Jan Bottu at 2020-05-21T12:11:31-04:00 Explicit Specificity Implementation for Ticket #16393. Explicit specificity allows users to manually create inferred type variables, by marking them with braces. This way, the user determines which variables can be instantiated through visible type application. The additional syntax is included in the parser, allowing users to write braces in type variable binders (type signatures, data constructors etc). This information is passed along through the renamer and verified in the type checker. The AST for type variable binders, data constructors, pattern synonyms, partial signatures and Template Haskell has been updated to include the specificity of type variables. Minor notes: - Bumps haddock submodule - Disables pattern match checking in GHC.Iface.Type with GHC 8.8 - - - - - 24e61aad by Ben Price at 2020-05-21T12:12:17-04:00 Lint should say when it is checking a rule It is rather confusing that when lint finds an error in a rule attached to a binder, it reports the error as in the RHS, not the rule: ... In the RHS of foo We add a clarifying line: ... In the RHS of foo In a rule attached to foo The implication that the rule lives inside the RHS is a bit odd, but this niggle is already present for unfoldings, whose pattern we are following. - - - - - 78c6523c by Ben Gamari at 2020-05-21T12:13:01-04:00 nonmoving: Optimise the write barrier - - - - - 13f6c9d0 by Andreas Klebinger at 2020-05-21T12:13:45-04:00 Refactor linear reg alloc to remember past assignments. When assigning registers we now first try registers we assigned to in the past, instead of picking the "first" one. This is in extremely helpful when dealing with loops for which variables are dead for part of the loop. This is important for patterns like this: foo = arg1 loop: use(foo) ... foo = getVal() goto loop; There we: * assign foo to the register of arg1. * use foo, it's dead after this use as it's overwritten after. * do other things. * look for a register to put foo in. If we pick an arbitrary one it might differ from the register the start of the loop expect's foo to be in. To fix this we simply look for past register assignments for the given variable. If we find one and the register is free we use that register. This reduces the need for fixup blocks which match the register assignment between blocks. In the example above between the end and the head of the loop. This patch also moves branch weight estimation ahead of register allocation and adds a flag to control it (cmm-static-pred). * It means the linear allocator is more likely to assign the hotter code paths first. * If it assign these first we are: + Less likely to spill on the hot path. + Less likely to introduce fixup blocks on the hot path. These two measure combined are surprisingly effective. Based on nofib we get in the mean: * -0.9% instructions executed * -0.1% reads/writes * -0.2% code size. * -0.1% compiler allocations. * -0.9% compile time. * -0.8% runtime. Most of the benefits are simply a result of removing redundant moves and spills. Reduced compiler allocations likely are the result of less code being generated. (The added lookup is mostly non-allocating). - - - - - edc2cc58 by Andreas Klebinger at 2020-05-21T12:14:25-04:00 NCG: Codelayout: Distinguish conditional and other branches. In #18053 we ended up with a suboptimal code layout because the code layout algorithm didn't distinguish between conditional and unconditional control flow. We can completely eliminate unconditional control flow instructions by placing blocks next to each other, not so much for conditionals. In terms of implementation we simply give conditional branches less weight before computing the layout. Fixes #18053 - - - - - b7a6b2f4 by Gleb Popov at 2020-05-21T12:15:26-04:00 gitlab-ci: Set locale to C.UTF-8. - - - - - a8c27cf6 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow spaces in GHCi :script file names This patch updates the user interface of GHCi so that file names passed to the ':script' command may contain spaces escaped with a backslash. For example: :script foo\ bar.script The implementation uses a modified version of 'words' that does not break on escaped spaces. Fixes #18027. - - - - - 82663959 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Add extra tests for GHCi :script syntax checks The syntax for GHCi's ":script" command allows for only a single file name to be passed as an argument. This patch adds a test for the cases in which a file name is missing or multiple file names are passed. Related to #T18027. - - - - - a0b79e1b by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Allow GHCi :script file names in double quotes This patch updates the user interface of GHCi so that file names passed to the ':script' command can be wrapped in double quotes. For example: :script "foo bar.script" The implementation uses a modified version of 'words' that treats character sequences enclosed in double quotes as single words. Fixes #18027. - - - - - cf566330 by Stefan Holdermans at 2020-05-21T12:16:08-04:00 Update documentation for GHCi :script This patch adds the fixes that allow for file names containing spaces to be passed to GHCi's ':script' command to the release notes for 8.12 and expands the user-guide documentation for ':script' by mentioning how such file names can be passed. Related to #18027. - - - - - 0004ccb8 by Tuan Le at 2020-05-21T12:16:46-04:00 llvmGen: Consider Relocatable read-only data as not constantReferences: #18137 - - - - - 964d3ea2 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_pat` - - - - - b797aa42 by John Ericson at 2020-05-21T12:17:30-04:00 Use `Checker` for `tc_lpat` and `tc_lpats` - - - - - 5108e84a by John Ericson at 2020-05-21T12:17:30-04:00 More judiciously panic in `ts_pat` - - - - - 510e0451 by John Ericson at 2020-05-21T12:17:30-04:00 Put `PatEnv` first in `GHC.Tc.Gen.Pat.Checker` - - - - - cb4231db by John Ericson at 2020-05-21T12:17:30-04:00 Tiny cleaup eta-reduce away a function argument In GHC, not in the code being compiled! - - - - - 6890c38d by John Ericson at 2020-05-21T12:17:30-04:00 Use braces with do in `SplicePat` case for consistency - - - - - 3451584f by buggymcbugfix at 2020-05-21T12:18:06-04:00 Fix spelling mistakes and typos - - - - - b552e531 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Add INLINABLE pragmas to Enum list producers The INLINABLE pragmas ensure that we export stable (unoptimised) unfoldings in the interface file so we can do list fusion at usage sites. Related tickets: #15185, #8763, #18178. - - - - - e7480063 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Piggyback on Enum Word methods for Word64 If we are on a 64 bit platform, we can use the efficient Enum Word methods for the Enum Word64 instance. - - - - - 892b0c41 by buggymcbugfix at 2020-05-21T12:18:06-04:00 Document INLINE(ABLE) pragmas that enable fusion - - - - - 2b363ebb by Richard Eisenberg at 2020-05-21T12:18:45-04:00 MR template should ask for key part - - - - - a95bbd0b by Sebastian Graf at 2020-05-21T12:19:37-04:00 Make `Int`'s `mod` and `rem` strict in their first arguments They used to be strict until 4d2ac2d (9 years ago). It's obviously better to be strict for performance reasons. It also blocks #18067. NoFib results: ``` -------------------------------------------------------------------------------- Program Allocs Instrs -------------------------------------------------------------------------------- integer -1.1% +0.4% wheel-sieve2 +21.2% +20.7% -------------------------------------------------------------------------------- Min -1.1% -0.0% Max +21.2% +20.7% Geometric Mean +0.2% +0.2% ``` The regression in `wheel-sieve2` is due to reboxing that likely will go away with the resolution of #18067. See !3282 for details. Fixes #18187. - - - - - d3d055b8 by Galen Huntington at 2020-05-21T12:20:18-04:00 Clarify pitfalls of NegativeLiterals; see #18022. - - - - - 1b508a9e by Alexey Kuleshevich at 2020-05-21T12:21:02-04:00 Fix wording in primops documentation to reflect the correct reasoning: * Besides resizing functions, shrinking ones also mutate the size of a mutable array and because of those two `sizeofMutabeByteArray` and `sizeofSmallMutableArray` are now deprecated * Change reference in documentation to the newer functions `getSizeof*` instead of `sizeof*` for shrinking functions * Fix incorrect mention of "byte" instead of "small" - - - - - 4ca0c8a1 by Andreas Klebinger at 2020-05-21T12:21:53-04:00 Don't variable-length encode magic iface constant. We changed to use variable length encodings for many types by default, including Word32. This makes sense for numbers but not when Word32 is meant to represent four bytes. I added a FixedLengthEncoding newtype to Binary who's instances interpret their argument as a collection of bytes instead of a number. We then use this when writing/reading magic numbers to the iface file. I also took the libery to remove the dummy iface field. This fixes #18180. - - - - - a1275081 by Krzysztof Gogolewski at 2020-05-21T12:22:35-04:00 Add a regression test for #11506 The testcase works now. See explanation in https://gitlab.haskell.org/ghc/ghc/issues/11506#note_273202 - - - - - 8a816e5f by Krzysztof Gogolewski at 2020-05-21T12:23:55-04:00 Sort deterministically metric output Previously, we sorted according to the test name and way, but the metrics (max_bytes_used/peak_megabytes_allocated etc.) were appearing in nondeterministic order. - - - - - 566cc73f by Sylvain Henry at 2020-05-21T12:24:45-04:00 Move isDynLinkName into GHC.Types.Name It doesn't belong into GHC.Unit.State - - - - - d830bbc9 by Adam Sandberg Ericsson at 2020-05-23T13:36:20-04:00 docs: fix formatting and add some links [skip ci] - - - - - 49301ad6 by Andrew Martin at 2020-05-23T13:37:01-04:00 Implement cstringLength# and FinalPtr This function and its accompanying rule resolve issue #5218. A future PR to the bytestring library will make the internal Data.ByteString.Internal.unsafePackAddress compute string length with cstringLength#. This will improve the status quo because it is eligible for constant folding. Additionally, introduce a new data constructor to ForeignPtrContents named FinalPtr. This additional data constructor, when used in the IsString instance for ByteString, leads to more Core-to-Core optimization opportunities, fewer runtime allocations, and smaller binaries. Also, this commit re-exports all the functions from GHC.CString (including cstringLength#) in GHC.Exts. It also adds a new test driver. This test driver is used to perform substring matches on Core that is dumped after all the simplifier passes. In this commit, it is used to check that constant folding of cstringLength# works. - - - - - dcd6bdcc by Ben Gamari at 2020-05-23T13:37:48-04:00 simplCore: Ignore ticks in rule templates This fixes #17619, where a tick snuck in to the template of a rule, resulting in a panic during rule matching. The tick in question was introduced via post-inlining, as discussed in `Note [Simplifying rules]`. The solution we decided upon was to simply ignore ticks in the rule template, as discussed in `Note [Tick annotations in RULE matching]`. Fixes #18162. Fixes #17619. - - - - - 82cb8913 by John Ericson at 2020-05-23T13:38:32-04:00 Fix #18145 and also avoid needless work with implicit vars - `forAllOrNothing` now is monadic, so we can trace whether we bind an explicit `forall` or not. - #18145 arose because the free vars calculation was needlessly complex. It is now greatly simplified. - Replaced some other implicit var code with `filterFreeVarsToBind`. Co-authored-by: Ryan Scott <ryan.gl.scott at gmail.com> - - - - - a60dc835 by Ben Gamari at 2020-05-23T13:39:12-04:00 Bump process submodule Fixes #17926. - - - - - 856adf54 by Ben Gamari at 2020-05-23T13:40:21-04:00 users-guide: Clarify meaning of -haddock flag Fixes #18206. - - - - - 7ae57afd by Ben Gamari at 2020-05-23T13:41:03-04:00 git: Add ignored commits file This can be used to tell git to ignore bulk renaming commits like the recently-finished module hierarchy refactoring. Configured with, git config blame.ignoreRevsFile .git-ignore-revs - - - - - 63d30e60 by jneira at 2020-05-24T01:54:42-04:00 Add hie-bios script for windows systems It is a direct translation of the sh script - - - - - 59182b88 by jneira at 2020-05-24T01:54:42-04:00 Honour previous values for CABAL and CABFLAGS The immediate goal is let the hie-bios.bat script set CABFLAGS with `-v0` and remove all cabal output except the compiler arguments - - - - - 932dc54e by jneira at 2020-05-24T01:54:42-04:00 Add specific configuration for windows in hie.yaml - - - - - e0eda070 by jneira at 2020-05-24T01:54:42-04:00 Remove not needed hie-bios output - - - - - a0ea59d6 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Move Config module into GHC.Settings - - - - - 37430251 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Core.Arity into GHC.Core.Opt.Arity - - - - - a426abb9 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Rename GHC.Hs.Types into GHC.Hs.Type See discussion in https://gitlab.haskell.org/ghc/ghc/issues/13009#note_268610 - - - - - 1c91a7a0 by Sylvain Henry at 2020-05-24T01:55:24-04:00 Bump haddock submodule - - - - - 66bd24d1 by Ryan Scott at 2020-05-24T01:56:03-04:00 Add orderingTyCon to wiredInTyCons (#18185) `Ordering` needs to be wired in for use in the built-in `CmpNat` and `CmpSymbol` type families, but somehow it was never added to the list of `wiredInTyCons`, leading to the various oddities observed in #18185. Easily fixed by moving `orderingTyCon` from `basicKnownKeyNames` to `wiredInTyCons`. Fixes #18185. - - - - - 01c43634 by Matthew Pickering at 2020-05-24T01:56:42-04:00 Remove unused hs-boot file - - - - - 7a07aa71 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix cross-compiler build (#16051) - - - - - 15ccca16 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix distDir per stage - - - - - b420fb24 by Sylvain Henry at 2020-05-24T15:22:17-04:00 Hadrian: fix hp2ps error during cross-compilation Fixed by @alp (see https://gitlab.haskell.org/ghc/ghc/issues/16051#note_274265) - - - - - cd339ef0 by Joshua Price at 2020-05-24T15:22:56-04:00 Make Unicode brackets opening/closing tokens (#18225) The tokens `[|`, `|]`, `(|`, and `|)` are opening/closing tokens as described in GHC Proposal #229. This commit makes the unicode variants (`⟦`, `⟧`, `⦇`, and `⦈`) act the same as their ASCII counterparts. - - - - - 013d7120 by Ben Gamari at 2020-05-25T09:48:17-04:00 Revert "Specify kind variables for inferred kinds in base." As noted in !3132, this has rather severe knock-on consequences in user-code. We'll need to revisit this before merging something along these lines. This reverts commit 9749fe1223d182b1f8e7e4f7378df661c509f396. - - - - - 4c4312ed by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Drop redundant ad-hoc boot module check To determine whether the module is a boot module Coverage.addTicksToBinds was checking for a `boot` suffix in the module source filename. This is quite ad-hoc and shouldn't be necessary; the callsite in `deSugar` already checks that the module isn't a boot module. - - - - - 1abf3c84 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make tickBoxCount strict This could otherwise easily cause a leak of (+) thunks. - - - - - b2813750 by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Make ccIndices strict This just seems like a good idea. - - - - - 02e278eb by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Don't produce ModBreaks if not HscInterpreted emptyModBreaks contains a bottom and consequently it's important that we don't use it unless necessary. - - - - - b8c014ce by Ben Gamari at 2020-05-25T09:48:53-04:00 Coverage: Factor out addMixEntry - - - - - 53814a64 by Zubin Duggal at 2020-05-26T03:03:24-04:00 Add info about typeclass evidence to .hie files See `testsuite/tests/hiefile/should_run/HieQueries.hs` and `testsuite/tests/hiefile/should_run/HieQueries.stdout` for an example of this We add two new fields, `EvidenceVarBind` and `EvidenceVarUse` to the `ContextInfo` associated with an Identifier. These are associated with the appropriate identifiers for the evidence variables collected when we come across `HsWrappers`, `TcEvBinds` and `IPBinds` while traversing the AST. Instance dictionary and superclass selector dictionaries from `tcg_insts` and classes defined in `tcg_tcs` are also recorded in the AST as originating from their definition span This allows us to save a complete picture of the evidence constructed by the constraint solver, and will let us report this to the user, enabling features like going to the instance definition from the invocation of a class method(or any other method taking a constraint) and finding all usages of a particular instance. Additionally, - Mark NodeInfo with an origin so we can differentiate between bindings origininating in the source vs those in ghc - Along with typeclass evidence info, also include information on Implicit Parameters - Add a few utility functions to HieUtils in order to query the new info Updates haddock submodule - - - - - 6604906c by Sebastian Graf at 2020-05-26T03:04:04-04:00 Make WorkWrap.Lib.isWorkerSmallEnough aware of the old arity We should allow a wrapper with up to 82 parameters when the original function had 82 parameters to begin with. I verified that this made no difference on NoFib, but then again it doesn't use huge records... Fixes #18122. - - - - - cf772f19 by Sylvain Henry at 2020-05-26T03:04:45-04:00 Enhance Note [About units] for Backpack - - - - - ede24126 by Takenobu Tani at 2020-05-27T00:13:55-04:00 core-spec: Modify file paths according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * GHC/Core.hs <= coreSyn/CoreSyn.hs * GHC/Core/Coercion.hs <= types/Coercion.hs * GHC/Core/Coercion/Axiom.hs <= types/CoAxiom.hs * GHC/Core/Coercion/Opt.hs <= types/OptCoercion.hs * GHC/Core/DataCon.hs <= basicTypes/DataCon.hs * GHC/Core/FamInstEnv.hs <= types/FamInstEnv.hs * GHC/Core/Lint.hs <= coreSyn/CoreLint.hs * GHC/Core/Subst.hs <= coreSyn/CoreSubst.hs * GHC/Core/TyCo/Rep.hs <= types/TyCoRep.hs * GHC/Core/TyCon.hs <= types/TyCon.hs * GHC/Core/Type.hs <= types/Type.hs * GHC/Core/Unify.hs <= types/Unify.hs * GHC/Types/Literal.hs <= basicTypes/Literal.hs * GHC/Types/Var.hs <= basicTypes/Var.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [skip ci] - - - - - 04750304 by Ben Gamari at 2020-05-27T00:14:33-04:00 eventlog: Fix racy flushing Previously no attempt was made to avoid multiple threads writing their capability-local eventlog buffers to the eventlog writer simultaneously. This could result in multiple eventlog streams being interleaved. Fix this by documenting that the EventLogWriter's write() and flush() functions may be called reentrantly and fix the default writer to protect its FILE* by a mutex. Fixes #18210. - - - - - d6203f24 by Joshua Price at 2020-05-27T00:15:17-04:00 Make `identifier` parse unparenthesized `->` (#18060) - - - - - 28deee28 by Ben Gamari at 2020-05-28T16:23:21-04:00 GHC.Core.Unfold: Refactor traceInline This reduces duplication as well as fixes a bug wherein -dinlining-check would override -ddump-inlinings. Moreover, the new variant - - - - - 1f393e1e by Ben Gamari at 2020-05-28T16:23:21-04:00 Avoid unnecessary allocations due to tracing utilities While ticky-profiling the typechecker I noticed that hundreds of millions of SDocs are being allocated just in case -ddump-*-trace is enabled. This is awful. We avoid this by ensuring that the dump flag check is inlined into the call site, ensuring that the tracing document needn't be allocated unless it's actually needed. See Note [INLINE conditional tracing utilities] for details. Fixes #18168. Metric Decrease: T9961 haddock.Cabal haddock.base haddock.compiler - - - - - 5f621a78 by Vladislav Zavialov at 2020-05-28T16:23:58-04:00 Add Semigroup/Monoid for Q (#18123) - - - - - dc5f004c by Xavier Denis at 2020-05-28T16:24:37-04:00 Fix #18071 Run the core linter on candidate instances to ensure they are well-kinded. Better handle quantified constraints by using a CtWanted to avoid having unsolved constraints thrown away at the end by the solver. - - - - - 10e6982c by Sebastian Graf at 2020-05-28T16:25:14-04:00 FloatOut: Only eta-expand dead-end RHS if arity will increase (#18231) Otherwise we risk turning trivial RHS into non-trivial RHS, introducing unnecessary bindings in the next Simplifier run, resulting in more churn. Fixes #18231. - - - - - 08dab5f7 by Sebastian Graf at 2020-05-28T16:25:14-04:00 DmdAnal: Recognise precise exceptions from case alternatives (#18086) Consider ```hs m :: IO () m = do putStrLn "foo" error "bar" ``` `m` (from #18086) always throws a (precise or imprecise) exception or diverges. Yet demand analysis infers `<L,A>` as demand signature instead of `<L,A>x` for it. That's because the demand analyser sees `putStrLn` occuring in a case scrutinee and decides that it has to `deferAfterPreciseException`, because `putStrLn` throws a precise exception on some control flow paths. This will mask the `botDiv` `Divergence`of the single case alt containing `error` to `topDiv`. Since `putStrLn` has `topDiv` itself, the final `Divergence` is `topDiv`. This is easily fixed: `deferAfterPreciseException` works by `lub`ing with the demand type of a virtual case branch denoting the precise exceptional control flow. We used `nopDmdType` before, but we can be more precise and use `exnDmdType`, which is `nopDmdType` with `exnDiv`. Now the `Divergence` from the case alt will degrade `botDiv` to `exnDiv` instead of `topDiv`, which combines with the result from the scrutinee to `exnDiv`, and all is well. Fixes #18086. - - - - - aef95f11 by Ben Gamari at 2020-05-28T16:25:53-04:00 Ticky-ticky: Record DataCon name in ticker name This makes it significantly easier to spot the nature of allocations regressions and comes at a reasonably low cost. - - - - - 8f021b8c by Ben Gamari at 2020-05-28T16:26:34-04:00 hadrian: Don't track GHC's verbosity argument Teach hadrian to ignore GHC's -v argument in its recompilation check, thus fixing #18131. - - - - - 13d9380b by Ben Gamari at 2020-05-28T16:27:20-04:00 Rip out CmmStackInfo(updfr_space) As noted in #18232, this field is currently completely unused and moreover doesn't have a clear meaning. - - - - - f10d11fa by Andreas Klebinger at 2020-05-29T01:38:42-04:00 Fix "build/elem" RULE. An redundant constraint prevented the rule from matching. Fixing this allows a call to elem on a known list to be translated into a series of equality checks, and eventually a simple case expression. Surprisingly this seems to regress elem for strings. To avoid this we now also allow foldrCString to inline and add an UTF8 variant. This results in elem being compiled to a tight non-allocating loop over the primitive string literal which performs a linear search. In the process this commit adds UTF8 variants for some of the functions in GHC.CString. This is required to make this work for both ASCII and UTF8 strings. There are also small tweaks to the CString related rules. We now allow ourselfes the luxury to compare the folding function via eqExpr, which helps to ensure the rule fires before we inline foldrCString*. Together with a few changes to allow matching on both the UTF8 and ASCII variants of the CString functions. - - - - - bbeb2389 by Ben Gamari at 2020-05-29T01:39:19-04:00 CoreToStg: Add Outputable ArgInfo instance - - - - - 0e3361ca by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Make Lint check return type of a join point Consider join x = rhs in body It's important that the type of 'rhs' is the same as the type of 'body', but Lint wasn't checking that invariant. Now it does! This was exposed by investigation into !3113. - - - - - c49f7df0 by Simon Peyton Jones at 2020-05-29T01:39:19-04:00 Do not float join points in exprIsConApp_maybe We hvae been making exprIsConApp_maybe cleverer in recent times: commit b78cc64e923716ac0512c299f42d4d0012306c05 Date: Thu Nov 15 17:14:31 2018 +0100 Make constructor wrappers inline only during the final phase commit 7833cf407d1f608bebb1d38bb99d3035d8d735e6 Date: Thu Jan 24 17:58:50 2019 +0100 Look through newtype wrappers (Trac #16254) commit c25b135ff5b9c69a90df0ccf51b04952c2dc6ee1 Date: Thu Feb 21 12:03:22 2019 +0000 Fix exprIsConApp_maybe But alas there was still a bug, now immortalised in Note [Don't float join points] in SimpleOpt. It's quite hard to trigger because it requires a dead join point, but it came up when compiling Cabal Cabal.Distribution.Fields.Lexer.hs, when working on !3113. Happily, the fix is extremly easy. Finding the bug was not so easy. - - - - - 46720997 by Ben Gamari at 2020-05-29T01:39:19-04:00 Allow simplification through runRW# Because runRW# inlines so late, we were previously able to do very little simplification across it. For instance, given even a simple program like case runRW# (\s -> let n = I# 42# in n) of I# n# -> f n# we previously had no way to avoid the allocation of the I#. This patch allows the simplifier to push strict contexts into the continuation of a runRW# application, as explained in in Note [Simplification of runRW#] in GHC.CoreToStg.Prep. Fixes #15127. Metric Increase: T9961 Metric Decrease: ManyConstructors Co-Authored-By: Simon Peyton-Jone <simonpj at microsoft.com> - - - - - 277c2f26 by Ben Gamari at 2020-05-29T01:39:55-04:00 Eta expand un-saturated primops Now since we no longer try to predict CAFfyness we have no need for the solution to #16846. Eta expanding unsaturated primop applications is conceptually simpler, especially in the presence of levity polymorphism. This essentially reverts cac8dc9f51e31e4c0a6cd9bc302f7e1bc7c03beb, as suggested in #18079. Closes #18079. - - - - - f44d7ae0 by Simon Jakobi at 2020-05-29T01:40:34-04:00 base: Scrap deprecation plan for Data.Monoid.{First,Last} See the discussion on the libraries mailing list for context: https://mail.haskell.org/pipermail/libraries/2020-April/030357.html - - - - - 8b494895 by Jeremy Schlatter at 2020-05-29T01:41:12-04:00 Fix typo in documentation - - - - - 998450f4 by Gleb Popov at 2020-05-29T01:41:53-04:00 Always define USE_PTHREAD_FOR_ITIMER for FreeBSD. - - - - - f9a513e0 by Alp Mestanogullari at 2020-05-29T01:42:36-04:00 hadrian: introduce 'install' target Its logic is very simple. It `need`s the `binary-dist-dir` target and runs suitable `configure` and `make install` commands for the user. A new `--prefix` command line argument is introduced to specify where GHC should be installed. - - - - - 67738db1 by Travis Whitaker at 2020-05-29T13:34:48-04:00 Build a threaded stage 1 if the bootstrapping GHC supports it. - - - - - aac19e6c by Peter Trommler at 2020-05-29T13:35:24-04:00 PPC NCG: No per-symbol .section ".toc" directives All position independent symbols are collected during code generation and emitted in one go. Prepending each symbol with a .section ".toc" directive is redundant. This patch drops the per-symbol directives leading to smaller assembler files. Fixes #18250 - - - - - 4413828b by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Teach getNumProcessors to return available processors Previously we would report the number of physical processors, which can be quite wrong in a containerized setting. Now we rather return how many processors are in our affinity mask when possible. I also refactored the code to prefer platform-specific since this will report logical CPUs instead of physical (using `machdep.cpu.thread_count` on Darwin and `cpuset_getaffinity` on FreeBSD). Fixes #14781. - - - - - 1449435c by Ben Gamari at 2020-05-30T06:07:31-04:00 users-guide: Note change in getNumProcessors in users guide - - - - - 3d960169 by Ben Gamari at 2020-05-30T06:07:31-04:00 rts: Drop compatibility shims for Windows Vista We can now assume that the thread and processor group interfaces are available. - - - - - 7f8f948c by Peter Trommler at 2020-05-30T06:08:07-04:00 PPC NCG: Fix .size directive on powerpc64 ELF v1 Thanks to Sergei Trofimovich for pointing out the issue. Fixes #18237 - - - - - 7c555b05 by Andreas Klebinger at 2020-05-30T06:08:43-04:00 Optimize GHC.Utils.Monad. Many functions in this module are recursive and as such are marked loop breakers. Which means they are unlikely to get an unfolding. This is *bad*. We always want to specialize them to specific Monads. Which requires a visible unfolding at the use site. I rewrote the recursive ones from: foo f x = ... foo x' ... to foo f x = go x where go x = ... As well as giving some pragmas to make all of them available for specialization. The end result is a reduction of allocations of about -1.4% for nofib/spectral/simple/Main.hs when compiled with `-O`. ------------------------- Metric Decrease: T12425 T14683 T5631 T9233 T9675 T9961 WWRec ------------------------- - - - - - 8b1cb5df by Ben Gamari at 2020-05-30T06:09:20-04:00 Windows: Bump Windows toolchain to 0.2 - - - - - 6947231a by Zubin Duggal at 2020-05-30T06:10:02-04:00 Simplify contexts in GHC.Iface.Ext.Ast - - - - - 2ee4f36c by Daniel Gröber at 2020-06-01T06:32:56-04:00 Cleanup OVERWRITING_CLOSURE logic The code is just more confusing than it needs to be. We don't need to mix the threaded check with the ldv profiling check since ldv's init already checks for this. Hence they can be two separate checks. Taking the sanity checking into account is also cleaner via DebugFlags.sanity. No need for checking the DEBUG define. The ZERO_SLOP_FOR_LDV_PROF and ZERO_SLOP_FOR_SANITY_CHECK definitions the old code had also make things a lot more opaque IMO so I removed those. - - - - - 6159559b by Daniel Gröber at 2020-06-01T06:32:56-04:00 Fix OVERWRITING_CLOSURE assuming closures are not inherently used The new ASSERT in LDV_recordDead() was being tripped up by MVars when removeFromMVarBlockedQueue() calls OVERWRITING_CLOSURE() via OVERWRITE_INFO(). - - - - - 38992085 by Daniel Gröber at 2020-06-01T06:32:56-04:00 Always zero shrunk mutable array slop when profiling When shrinking arrays in the profiling way we currently don't always zero the leftover slop. This means we can't traverse such closures in the heap profiler. The old Note [zeroing slop] and #8402 have some rationale for why this is so but I belive the reasoning doesn't apply to mutable closures. There users already have to ensure multiple threads don't step on each other's toes so zeroing should be safe. - - - - - b0c1f2a6 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for #18151 - - - - - 9a99a178 by Ben Gamari at 2020-06-01T06:33:37-04:00 testsuite: Add test for desugaring of PostfixOperators - - - - - 2b89ca5b by Ben Gamari at 2020-06-01T06:33:37-04:00 HsToCore: Eta expand left sections Strangely, the comment next to this code already alluded to the fact that even simply eta-expanding will sacrifice laziness. It's quite unclear how we regressed so far. See #18151. - - - - - d412d7a3 by Kirill Elagin at 2020-06-01T06:34:21-04:00 Winferred-safe-imports: Do not exit with error Currently, when -Winferred-safe-imports is enabled, even when it is not turned into an error, the compiler will still exit with exit code 1 if this warning was emitted. Make sure it is really treated as a warning. - - - - - f945eea5 by Ben Gamari at 2020-06-01T06:34:58-04:00 nonmoving: Optimise log2_ceil - - - - - aab606e4 by Bodigrim at 2020-06-01T06:35:36-04:00 Clarify description of fromListN - - - - - 7e5220e2 by Bodigrim at 2020-06-01T06:35:36-04:00 Apply suggestion to libraries/base/GHC/Exts.hs - - - - - f3fb1ce9 by fendor at 2020-06-01T06:36:18-04:00 Add `isInScope` check to `lintCoercion` Mirrors the behaviour of `lintType`. - - - - - 5ac4d946 by fendor at 2020-06-01T06:36:18-04:00 Lint rhs of IfaceRule - - - - - 1cef6126 by Jeremy Schlatter at 2020-06-01T06:37:00-04:00 Fix wording in documentation The duplicate "orphan instance" phrase here doesn't make sense, and was probably an accident. - - - - - 5aaf08f2 by Takenobu Tani at 2020-06-01T06:37:43-04:00 configure: Modify aclocal.m4 according to new module hierarchy This patch updates file paths according to new module hierarchy [1]: * Rename: * compiler/GHC/Parser.hs <= compiler/parser/Parser.hs * compiler/GHC/Parser/Lexer.hs <= compiler/Parser/Lexer.hs * Add: * compiler/GHC/Cmm/Lexer.hs [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular - - - - - 15857ad8 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Don't fail if we can't unlink __symlink_test Afterall, it's possible we were unable to create it due to lack of symlink permission. - - - - - 4a7229ef by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Refactor ghostscript detection Tamar reported that he saw crashes due to unhandled exceptions. - - - - - 2ab37eaf by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/perf_notes: Fix ill-typed assignments - - - - - e45d5b66 by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite/testutil: Fix bytes/str mismatch - - - - - 7002d0cb by Ben Gamari at 2020-06-01T06:38:26-04:00 testsuite: Work around spurious mypy failure - - - - - 11390e3a by Takenobu Tani at 2020-06-01T06:39:05-04:00 Clean up file paths for new module hierarchy This updates comments only. This patch replaces file references according to new module hierarchy. See also: * https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular * https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 8f2e5732 by Takenobu Tani at 2020-06-01T06:39:05-04:00 Modify file paths to module paths for new module hierarchy This updates comments only. This patch replaces module references according to new module hierarchy [1][2]. For files under the `compiler/` directory, I replace them as module paths instead of file paths. For instance, `GHC.Unit.State` instead of `compiler/GHC/Unit/State.hs` [3]. For current and future haddock's markup, this patch encloses the module name with "" [4]. [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 [3]: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3375#note_276613 [4]: https://haskell-haddock.readthedocs.io/en/latest/markup.html#linking-to-modules - - - - - 68b71c4a by Tom Ellis at 2020-06-01T06:39:55-04:00 Rename the singleton tuple GHC.Tuple.Unit to GHC.Tuple.Solo - - - - - 95da76c2 by Sylvain Henry at 2020-06-01T06:40:41-04:00 Hadrian: fix binary-dist target for cross-compilation - - - - - 730fcd54 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for the @-operator Since GHC diverges from the Haskell Report by allowing the user to define (@) as an infix operator, we better give a good error message when the user does so unintentionally. In general, this is rather hard to do, as some failures will be discovered only in the renamer or the type checker: x :: (Integer, Integer) x @ (a, b) = (1, 2) This patch does *not* address this general case. However, it gives much better error messages when the binding is not syntactically valid: pairs xs @ (_:xs') = zip xs xs' Before this patch, the error message was rather puzzling: <interactive>:1:1: error: Parse error in pattern: pairs After this patch, the error message includes a hint: <interactive>:1:1: error: Parse error in pattern: pairs In a function binding for the ‘@’ operator. Perhaps you meant an as-pattern, which must not be surrounded by whitespace - - - - - 0fde5377 by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TypeApplications With this patch, we always parse f @t as a type application, thereby producing better error messages. This steals two syntactic forms: * Prefix form of the @-operator in expressions. Since the @-operator is a divergence from the Haskell Report anyway, this is not a major loss. * Prefix form of @-patterns. Since we are stealing loose infix form anyway, might as well sacrifice the prefix form for the sake of much better error messages. - - - - - c68e7e1e by Vladislav Zavialov at 2020-06-01T06:41:18-04:00 Improve parser error messages for TemplateHaskellQuotes While [e| |], [t| |], [d| |], and so on, steal syntax from list comprehensions, [| |] and [|| ||] do not steal any syntax. Thus we can improve error messages by always accepting them in the lexer. Turns out the renamer already performs necessary validation. - - - - - 120aedbd by Ben Gamari at 2020-06-01T16:07:02-04:00 gitlab-ci: Disable use of ld.lld on ARMv7 It turns out that lld non-deterministically fails on ARMv7. I suspect this may be due to the a kernel regression as this only started happening when we upgraded to 5.4. Nevertheless, easily avoided by simply sticking with gold. Works around #18280. - - - - - d6279ff0 by Ben Gamari at 2020-06-02T13:03:30-04:00 gitlab-ci: Ensure that workaround for #18280 applies to bindisttest We need to ensure that the `configure` flags working around #18280 are propagated to the bindisttest `configure` as well. - - - - - cb5c31b5 by Ben Gamari at 2020-06-03T17:55:04-04:00 gitlab-ci: Allow ARMv7 job to fail Due to #18298. - - - - - 32a4ae90 by John Ericson at 2020-06-04T04:34:42-04:00 Clean up boot vs non-boot disambiguating types We often have (ModuleName, Bool) or (Module, Bool) pairs for "extended" module names (without or with a unit id) disambiguating boot and normal modules. We think this is important enough across the compiler that it deserves a new nominal product type. We do this with synnoyms and a functor named with a `Gen` prefix, matching other newly created definitions. It was also requested that we keep custom `IsBoot` / `NotBoot` sum type. So we have it too. This means changing many the many bools to use that instead. Updates `haddock` submodule. - - - - - c05756cd by Niklas Hambüchen at 2020-06-04T04:35:24-04:00 docs: Add more details on InterruptibleFFI. Details from https://gitlab.haskell.org/ghc/ghc/issues/8684 and https://github.com/takano-akio/filelock/pull/7#discussion_r280332430 - - - - - 1b975aed by Andrew Martin at 2020-06-04T04:36:03-04:00 Allow finalizeForeignPtr to be called on FinalPtr/PlainPtr. MR 2165 (commit 49301ad6226d9a83d110bee8c419615dd94f5ded) regressed finalizeForeignPtr by throwing exceptions when PlainPtr was encounterd. This regression did not make it into a release of GHC. Here, the original behavior is restored, and FinalPtr is given the same treatment as PlainPtr. - - - - - 2bd3929a by Luke Lau at 2020-06-04T04:36:41-04:00 Fix documentation on type families not being extracted It looks like the location of the Names used for CoAxioms on type families are now located at their type constructors. Previously, Docs.hs thought the Names were located in the RHS, so the RealSrcSpan in the instanceMap and getInstLoc didn't match up. Fixes #18241 - - - - - 6735b9d9 by Ben Gamari at 2020-06-04T04:37:21-04:00 GHC.Hs.Instances: Compile with -O0 This module contains exclusively Data instances, which are going to be slow no matter what we do. Furthermore, they are incredibly slow to compile with optimisation (see #9557). Consequently we compile this with -O0. See #18254. - - - - - c330331a by nineonine at 2020-06-04T04:37:59-04:00 Add test for #17669 - - - - - cab684f0 by Ben Gamari at 2020-06-04T04:38:36-04:00 rts: Add Windows-specific implementation of rtsSleep Previously we would use the POSIX path, which uses `nanosleep`. However, it turns out that `nanosleep` is provided by `libpthread` on Windows. In general we don't want to incur such a dependency. Avoid this by simply using `Sleep` on Windows. Fixes #18272. - - - - - ad44b504 by Ben Gamari at 2020-06-04T04:38:36-04:00 compiler: Disable use of process jobs with process < 1.6.9 Due to #17926. - - - - - 6a4098a4 by Moritz Angermann at 2020-06-04T04:55:51-04:00 [linker] Adds void printLoadedObjects(void); This allows us to dump in-memory object code locations for debugging. Fixup printLoadedObjects prototype - - - - - af5e3a88 by Artem Pelenitsyn at 2020-06-05T03:18:49-04:00 base: fix sign confusion in log1mexp implementation (fix #17125) author: claude (https://gitlab.haskell.org/trac-claude) The correct threshold for log1mexp is -(log 2) with the current specification of log1mexp. This change improves accuracy for large negative inputs. To avoid code duplication, a small helper function is added; it isn't the default implementation in Floating because it needs Ord. This patch does nothing to address that the Haskell specification is different from that in common use in other languages. - - - - - 2b792fac by Simon Peyton Jones at 2020-06-05T09:27:50-04:00 Simple subsumption This patch simplifies GHC to use simple subsumption. Ticket #17775 Implements GHC proposal #287 https://github.com/ghc-proposals/ghc-proposals/blob/master/ proposals/0287-simplify-subsumption.rst All the motivation is described there; I will not repeat it here. The implementation payload: * tcSubType and friends become noticably simpler, because it no longer uses eta-expansion when checking subsumption. * No deeplyInstantiate or deeplySkolemise That in turn means that some tests fail, by design; they can all be fixed by eta expansion. There is a list of such changes below. Implementing the patch led me into a variety of sticky corners, so the patch includes several othe changes, some quite significant: * I made String wired-in, so that "foo" :: String rather than "foo" :: [Char] This improves error messages, and fixes #15679 * The pattern match checker relies on knowing about in-scope equality constraints, andd adds them to the desugarer's environment using addTyCsDs. But the co_fn in a FunBind was missed, and for some reason simple-subsumption ends up with dictionaries there. So I added a call to addTyCsDs. This is really part of #18049. * I moved the ic_telescope field out of Implication and into ForAllSkol instead. This is a nice win; just expresses the code much better. * There was a bug in GHC.Tc.TyCl.Instance.tcDataFamInstHeader. We called checkDataKindSig inside tc_kind_sig, /before/ solveEqualities and zonking. Obviously wrong, easily fixed. * solveLocalEqualitiesX: there was a whole mess in here, around failing fast enough. I discovered a bad latent bug where we could successfully kind-check a type signature, and use it, but have unsolved constraints that could fill in coercion holes in that signature -- aargh. It's all explained in Note [Failure in local type signatures] in GHC.Tc.Solver. Much better now. * I fixed a serious bug in anonymous type holes. IN f :: Int -> (forall a. a -> _) -> Int that "_" should be a unification variable at the /outer/ level; it cannot be instantiated to 'a'. This was plain wrong. New fields mode_lvl and mode_holes in TcTyMode, and auxiliary data type GHC.Tc.Gen.HsType.HoleMode. This fixes #16292, but makes no progress towards the more ambitious #16082 * I got sucked into an enormous refactoring of the reporting of equality errors in GHC.Tc.Errors, especially in mkEqErr1 mkTyVarEqErr misMatchMsg misMatchMsgOrCND In particular, the very tricky mkExpectedActualMsg function is gone. It took me a full day. But the result is far easier to understand. (Still not easy!) This led to various minor improvements in error output, and an enormous number of test-case error wibbles. One particular point: for occurs-check errors I now just say Can't match 'a' against '[a]' rather than using the intimidating language of "occurs check". * Pretty-printing AbsBinds Tests review * Eta expansions T11305: one eta expansion T12082: one eta expansion (undefined) T13585a: one eta expansion T3102: one eta expansion T3692: two eta expansions (tricky) T2239: two eta expansions T16473: one eta determ004: two eta expansions (undefined) annfail06: two eta (undefined) T17923: four eta expansions (a strange program indeed!) tcrun035: one eta expansion * Ambiguity check at higher rank. Now that we have simple subsumption, a type like f :: (forall a. Eq a => Int) -> Int is no longer ambiguous, because we could write g :: (forall a. Eq a => Int) -> Int g = f and it'd typecheck just fine. But f's type is a bit suspicious, and we might want to consider making the ambiguity check do a check on each sub-term. Meanwhile, these tests are accepted, whereas they were previously rejected as ambiguous: T7220a T15438 T10503 T9222 * Some more interesting error message wibbles T13381: Fine: one error (Int ~ Exp Int) rather than two (Int ~ Exp Int, Exp Int ~ Int) T9834: Small change in error (improvement) T10619: Improved T2414: Small change, due to order of unification, fine T2534: A very simple case in which a change of unification order means we get tow unsolved constraints instead of one tc211: bizarre impredicative tests; just accept this for now Updates Cabal and haddock submodules. Metric Increase: T12150 T12234 T5837 haddock.base Metric Decrease: haddock.compiler haddock.Cabal haddock.base Merge note: This appears to break the `UnliftedNewtypesDifficultUnification` test. It has been marked as broken in the interest of merging. (cherry picked from commit 66b7b195cb3dce93ed5078b80bf568efae904cc5) - - - - - 2dff8141 by Ryan Scott at 2020-06-05T14:21:24-04:00 Simplify bindLHsTyVarBndrs and bindHsQTyVars Both `bindLHsTyVarBndrs` and `bindHsQTyVars` take two separate `Maybe` arguments, which I find terribly confusing. Thankfully, it's possible to remove one `Maybe` argument from each of these functions, which this patch accomplishes: * `bindHsQTyVars` takes a `Maybe SDoc` argument, which is `Just` if GHC should warn about any of the quantified type variables going unused. However, every call site uses `Nothing` in practice. This makes sense, since it doesn't really make sense to warn about unused type variables bound by an `LHsQTyVars`. For instance, you wouldn't warn about the `a` in `data Proxy a = Proxy` going unused. As a result, I simply remove this `Maybe SDoc` argument altogether. * `bindLHsTyVarBndrs` also takes a `Maybe SDoc` argument for the same reasons that `bindHsQTyVars` took one. To make things more confusing, however, `bindLHsTyVarBndrs` also takes a separate `HsDocContext` argument, which is pretty-printed (to an `SDoc`) in warnings and error messages. In practice, the `Maybe SDoc` and the `HsDocContext` often contain the same text. See the call sites for `bindLHsTyVarBndrs` in `rnFamInstEqn` and `rnConDecl`, for instance. There are only a handful of call sites where the text differs between the `Maybe SDoc` and `HsDocContext` arguments: * In `rnHsRuleDecl`, where the `Maybe SDoc` says "`In the rule`" and the `HsDocContext` says "`In the transformation rule`". * In `rnHsTyKi`/`rn_ty`, where the `Maybe SDoc` says "`In the type`" but the `HsDocContext` is inhereted from the surrounding context (e.g., if `rnHsTyKi` were called on a top-level type signature, the `HsDocContext` would be "`In the type signature`" instead) In both cases, warnings/error messages arguably _improve_ by unifying making the `Maybe SDoc`'s text match that of the `HsDocContext`. As a result, I decided to remove the `Maybe SDoc` argument to `bindLHsTyVarBndrs` entirely and simply reuse the text from the `HsDocContext`. (I decided to change the phrase "transformation rule" to "rewrite rule" while I was in the area.) The `Maybe SDoc` argument has one other purpose: signaling when to emit "`Unused quantified type variable`" warnings. To recover this functionality, I replaced the `Maybe SDoc` argument with a boolean-like `WarnUnusedForalls` argument. The only `bindLHsTyVarBndrs` call site that chooses _not_ to emit these warnings in `bindHsQTyVars`. - - - - - e372331b by Ben Gamari at 2020-06-07T08:46:41-04:00 hadrian: Add missing deriveConstants dependency on ghcplatform.h deriveConstants wants to compile C sources which #include PosixSource.h, which itself #includes ghcplatform.h. Make sure that Hadrian knows about this dependency. Fixes #18290. - - - - - b022051a by Moritz Angermann at 2020-06-07T08:46:42-04:00 ghc-prim needs to depend on libc and libm libm is just an empty shell on musl, and all the math functions are contained in libc. - - - - - 6dae6548 by Moritz Angermann at 2020-06-07T08:46:42-04:00 Disable DLL loading if without system linker Some platforms (musl, aarch64) do not have a working dynamic linker implemented in the libc, even though we might see dlopen. It will ultimately just return that this is not supported. Hence we'll add a flag to the compiler to flat our disable loading dlls. This is needed as we will otherwise try to load the shared library even if this will subsequently fail. At that point we have given up looking for static options though. - - - - - 4a158ffc by Moritz Angermann at 2020-06-07T08:46:43-04:00 Range is actually +/-2^32, not +/-2^31 See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf - - - - - f1bfb806 by Ben Gamari at 2020-06-07T10:49:30-04:00 OccurAnal: Avoid exponential behavior due to where clauses Previously the `Var` case of `occAnalApp` could in some cases (namely in the case of `runRW#` applications) call `occAnalRhs` two. In the case of nested `runRW#`s this results in exponential complexity. In some cases the compilation time that resulted would be very long indeed (see #18296). Fixes #18296. Metric Decrease: T9961 T12150 T12234 - - - - - 9b607671 by Takenobu Tani at 2020-06-09T08:05:46-04:00 Add link to GHC's wiki in the GHC API header This adds a URL to point to GHC's wiki in the GHC API header. Newcomers could easily find more information from the GHC API's web like [1]. [1]: Current version, https://ghc.gitlab.haskell.org/ghc/doc/libraries/ghc-8.11.0.20200604/index.html [skip ci] - - - - - 72c7fe9a by Ryan Scott at 2020-06-09T08:06:24-04:00 Make GADT constructors adhere to the forall-or-nothing rule properly Issue #18191 revealed that the types of GADT constructors don't quite adhere to the `forall`-or-nothing rule. This patch serves to clean up this sad state of affairs somewhat. The main change is not in the code itself, but in the documentation, as this patch introduces two sections to the GHC User's Guide: * A "Formal syntax for GADTs" section that presents a BNF-style grammar for what is and isn't allowed in GADT constructor types. This mostly exists to codify GHC's existing behavior, but it also imposes a new restriction that addresses #18191: the outermost `forall` and/or context in a GADT constructor is not allowed to be surrounded by parentheses. Doing so would make these `forall`s/contexts nested, and GADTs do not support nested `forall`s/contexts at present. * A "`forall`-or-nothing rule" section that describes exactly what the `forall`-or-nothing rule is all about. Surprisingly, there was no mention of this anywhere in the User's Guide up until now! To adhere the new specification in the "Formal syntax for GADTs" section of the User's Guide, the following code changes were made: * A new function, `GHC.Hs.Type.splitLHsGADTPrefixTy`, was introduced. This is very much like `splitLHsSigmaTy`, except that it avoids splitting apart any parentheses, which can be syntactically significant for GADT types. See `Note [No nested foralls or contexts in GADT constructors]` in `GHC.Hs.Type`. * `ConDeclGADTPrefixPs`, an extension constructor for `XConDecl`, was introduced so that `GHC.Parser.PostProcess.mkGadtDecl` can return it when given a prefix GADT constructor. Unlike `ConDeclGADT`, `ConDeclGADTPrefixPs` does not split the GADT type into its argument and result types, as this cannot be done until after the type is renamed (see `Note [GADT abstract syntax]` in `GHC.Hs.Decls` for why this is the case). * `GHC.Renamer.Module.rnConDecl` now has an additional case for `ConDeclGADTPrefixPs` that (1) splits apart the full `LHsType` into its `forall`s, context, argument types, and result type, and (2) checks for nested `forall`s/contexts. Step (2) used to be performed the typechecker (in `GHC.Tc.TyCl.badDataConTyCon`) rather than the renamer, but now the relevant code from the typechecker can simply be deleted. One nice side effect of this change is that we are able to give a more accurate error message for GADT constructors that use visible dependent quantification (e.g., `MkFoo :: forall a -> a -> Foo a`), which improves the stderr in the `T16326_Fail6` test case. Fixes #18191. Bumps the Haddock submodule. - - - - - a47e6442 by Ryan Scott at 2020-06-10T03:39:12-04:00 Always use rnImplicitBndrs to bring implicit tyvars into scope This implements a first step towards #16762 by changing the renamer to always use `rnImplicitBndrs` to bring implicitly bound type variables into scope. The main change is in `rnFamInstEqn` and `bindHsQTyVars`, which previously used _ad hoc_ methods of binding their implicit tyvars. There are a number of knock-on consequences: * One of the reasons that `rnFamInstEqn` used an _ad hoc_ binding mechanism was to give more precise source locations in `-Wunused-type-patterns` warnings. (See https://gitlab.haskell.org/ghc/ghc/issues/16762#note_273343 for an example of this.) However, these warnings are actually a little _too_ precise, since implicitly bound type variables don't have exact binding sites like explicitly bound type variables do. A similar problem existed for "`Different names for the same type variable`" errors involving implicit tyvars bound by `bindHsQTyVars`. Therefore, we simply accept the less precise (but more accurate) source locations from `rnImplicitBndrs` in `rnFamInstEqn` and `bindHsQTyVars`. See `Note [Source locations for implicitly bound type variables]` in `GHC.Rename.HsType` for the full story. * In order for `rnImplicitBndrs` to work in `rnFamInstEqn`, it needs to be able to look up names from the parent class (in the event that we are renaming an associated type family instance). As a result, `rnImplicitBndrs` now takes an argument of type `Maybe assoc`, which is `Just` in the event that a type family instance is associated with a class. * Previously, GHC kept track of three type synonyms for free type variables in the renamer: `FreeKiTyVars`, `FreeKiTyVarsDups` (which are allowed to contain duplicates), and `FreeKiTyVarsNoDups` (which contain no duplicates). However, making is a distinction between `-Dups` and `-NoDups` is now pointless, as all code that returns `FreeKiTyVars{,Dups,NoDups}` will eventually end up being passed to `rnImplicitBndrs`, which removes duplicates. As a result, I decided to just get rid of `FreeKiTyVarsDups` and `FreeKiTyVarsNoDups`, leaving only `FreeKiTyVars`. * The `bindLRdrNames` and `deleteBys` functions are now dead code, so I took the liberty of removing them. - - - - - 24879129 by Takenobu Tani at 2020-06-10T03:39:59-04:00 Clarify leaf module names for new module hierarchy This updates comments only. This patch replaces leaf module names according to new module hierarchy [1][2] as followings: * Expand leaf names to easily find the module path: for instance, `Id.hs` to `GHC.Types.Id`. * Modify leaf names according to new module hierarchy: for instance, `Convert.hs` to `GHC.ThToHs`. * Fix typo: for instance, `GHC.Core.TyCo.Rep.hs` to `GHC.Core.TyCo.Rep` See also !3375 [1]: https://gitlab.haskell.org/ghc/ghc/-/wikis/Make-GHC-codebase-more-modular [2]: https://gitlab.haskell.org/ghc/ghc/issues/13009 - - - - - 92de9e25 by Ömer Sinan Ağacan at 2020-06-10T03:41:07-04:00 rts: Remove unused GET_ENTRY closure macro This macro is not used and got broken in the meantime, as ENTRY_CODE was deleted. - - - - - 87102928 by Ömer Sinan Ağacan at 2020-06-10T03:41:50-04:00 Fix -fkeep-cafs flag name in users guide - - - - - ccd6843d by Shayne Fletcher at 2020-06-10T04:14:57-04:00 Expose impliedGFlags, impledOffGFlags, impliedXFlags - - - - - 7a737e89 by Ömer Sinan Ağacan at 2020-06-10T04:14:58-04:00 Cross-module LambdaFormInfo passing - Store LambdaFormInfos of exported Ids in interface files - Use them in importing modules This is for optimization purposes: if we know LambdaFormInfo of imported Ids we can generate more efficient calling code, see `getCallMethod`. Exporting (putting them in interface files or in ModDetails) and importing (reading them from interface files) are both optional. We don't assume known LambdaFormInfos anywhere and do not change how we call Ids with unknown LambdaFormInfos. Runtime, allocation, and residency numbers when building Cabal-the-library (commit 0d4ee7ba3): (Log and .hp files are in the MR: !2842) | | GHC HEAD | This patch | Diff | |-----|----------|------------|----------------| | -O0 | 0:35.89 | 0:34.10 | -1.78s, -4.98% | | -O1 | 2:24.01 | 2:23.62 | -0.39s, -0.27% | | -O2 | 2:52.23 | 2:51.35 | -0.88s, -0.51% | | | GHC HEAD | This patch | Diff | |-----|-----------------|-----------------|----------------------------| | -O0 | 54,843,608,416 | 54,878,769,544 | +35,161,128 bytes, +0.06% | | -O1 | 227,136,076,400 | 227,569,045,168 | +432,968,768 bytes, +0.19% | | -O2 | 266,147,063,296 | 266,749,643,440 | +602,580,144 bytes, +0.22% | NOTE: Residency is measured with extra runtime args: `-i0 -h` which effectively turn all GCs into major GCs, and do GC more often. | | GHC HEAD | This patch | Diff | |-----|----------------------------|------------------------------|----------------------------| | -O0 | 410,284,000 (910 samples) | 411,745,008 (906 samples) | +1,461,008 bytes, +0.35% | | -O1 | 928,580,856 (2109 samples) | 943,506,552 (2103 samples) | +14,925,696 bytes, +1.60% | | -O2 | 993,951,352 (2549 samples) | 1,010,156,328 (2545 samples) | +16,204,9760 bytes, +1.63% | NoFib results: -------------------------------------------------------------------------------- Program Size Allocs Instrs Reads Writes -------------------------------------------------------------------------------- CS 0.0% 0.0% +0.0% +0.0% +0.0% CSD 0.0% 0.0% 0.0% +0.0% +0.0% FS 0.0% 0.0% +0.0% +0.0% +0.0% S 0.0% 0.0% +0.0% +0.0% +0.0% VS 0.0% 0.0% +0.0% +0.0% +0.0% VSD 0.0% 0.0% +0.0% +0.0% +0.1% VSM 0.0% 0.0% +0.0% +0.0% +0.0% anna 0.0% 0.0% -0.3% -0.8% -0.0% ansi 0.0% 0.0% -0.0% -0.0% 0.0% atom 0.0% 0.0% -0.0% -0.0% 0.0% awards 0.0% 0.0% -0.1% -0.3% 0.0% banner 0.0% 0.0% -0.0% -0.0% -0.0% bernouilli 0.0% 0.0% -0.0% -0.0% -0.0% binary-trees 0.0% 0.0% -0.0% -0.0% +0.0% boyer 0.0% 0.0% -0.0% -0.0% 0.0% boyer2 0.0% 0.0% -0.0% -0.0% 0.0% bspt 0.0% 0.0% -0.0% -0.2% 0.0% cacheprof 0.0% 0.0% -0.1% -0.4% +0.0% calendar 0.0% 0.0% -0.0% -0.0% 0.0% cichelli 0.0% 0.0% -0.9% -2.4% 0.0% circsim 0.0% 0.0% -0.0% -0.0% 0.0% clausify 0.0% 0.0% -0.1% -0.3% 0.0% comp_lab_zift 0.0% 0.0% -0.0% -0.0% +0.0% compress 0.0% 0.0% -0.0% -0.0% -0.0% compress2 0.0% 0.0% -0.0% -0.0% 0.0% constraints 0.0% 0.0% -0.1% -0.2% -0.0% cryptarithm1 0.0% 0.0% -0.0% -0.0% 0.0% cryptarithm2 0.0% 0.0% -1.4% -4.1% -0.0% cse 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e1 0.0% 0.0% -0.0% -0.0% -0.0% digits-of-e2 0.0% 0.0% -0.0% -0.0% -0.0% dom-lt 0.0% 0.0% -0.1% -0.2% 0.0% eliza 0.0% 0.0% -0.5% -1.5% 0.0% event 0.0% 0.0% -0.0% -0.0% -0.0% exact-reals 0.0% 0.0% -0.1% -0.3% +0.0% exp3_8 0.0% 0.0% -0.0% -0.0% -0.0% expert 0.0% 0.0% -0.3% -1.0% -0.0% fannkuch-redux 0.0% 0.0% +0.0% +0.0% +0.0% fasta 0.0% 0.0% -0.0% -0.0% +0.0% fem 0.0% 0.0% -0.0% -0.0% 0.0% fft 0.0% 0.0% -0.0% -0.0% 0.0% fft2 0.0% 0.0% -0.0% -0.0% 0.0% fibheaps 0.0% 0.0% -0.0% -0.0% +0.0% fish 0.0% 0.0% 0.0% -0.0% +0.0% fluid 0.0% 0.0% -0.4% -1.2% +0.0% fulsom 0.0% 0.0% -0.0% -0.0% 0.0% gamteb 0.0% 0.0% -0.1% -0.3% 0.0% gcd 0.0% 0.0% -0.0% -0.0% 0.0% gen_regexps 0.0% 0.0% -0.0% -0.0% -0.0% genfft 0.0% 0.0% -0.0% -0.0% 0.0% gg 0.0% 0.0% -0.0% -0.0% +0.0% grep 0.0% 0.0% -0.0% -0.0% -0.0% hidden 0.0% 0.0% -0.1% -0.4% -0.0% hpg 0.0% 0.0% -0.2% -0.5% +0.0% ida 0.0% 0.0% -0.0% -0.0% +0.0% infer 0.0% 0.0% -0.3% -0.8% -0.0% integer 0.0% 0.0% -0.0% -0.0% +0.0% integrate 0.0% 0.0% -0.0% -0.0% 0.0% k-nucleotide 0.0% 0.0% -0.0% -0.0% +0.0% kahan 0.0% 0.0% -0.0% -0.0% +0.0% knights 0.0% 0.0% -2.2% -5.4% 0.0% lambda 0.0% 0.0% -0.6% -1.8% 0.0% last-piece 0.0% 0.0% -0.0% -0.0% 0.0% lcss 0.0% 0.0% -0.0% -0.1% 0.0% life 0.0% 0.0% -0.0% -0.1% 0.0% lift 0.0% 0.0% -0.2% -0.6% +0.0% linear 0.0% 0.0% -0.0% -0.0% -0.0% listcompr 0.0% 0.0% -0.0% -0.0% 0.0% listcopy 0.0% 0.0% -0.0% -0.0% 0.0% maillist 0.0% 0.0% -0.1% -0.3% +0.0% mandel 0.0% 0.0% -0.0% -0.0% 0.0% mandel2 0.0% 0.0% -0.0% -0.0% -0.0% mate +0.0% 0.0% -0.0% -0.0% -0.0% minimax 0.0% 0.0% -0.2% -1.0% 0.0% mkhprog 0.0% 0.0% -0.1% -0.2% -0.0% multiplier 0.0% 0.0% -0.0% -0.0% -0.0% n-body 0.0% 0.0% -0.0% -0.0% +0.0% nucleic2 0.0% 0.0% -0.1% -0.2% 0.0% para 0.0% 0.0% -0.0% -0.0% -0.0% paraffins 0.0% 0.0% -0.0% -0.0% 0.0% parser 0.0% 0.0% -0.2% -0.7% 0.0% parstof 0.0% 0.0% -0.0% -0.0% +0.0% pic 0.0% 0.0% -0.0% -0.0% 0.0% pidigits 0.0% 0.0% +0.0% +0.0% +0.0% power 0.0% 0.0% -0.2% -0.6% +0.0% pretty 0.0% 0.0% -0.0% -0.0% -0.0% primes 0.0% 0.0% -0.0% -0.0% 0.0% primetest 0.0% 0.0% -0.0% -0.0% -0.0% prolog 0.0% 0.0% -0.3% -1.1% 0.0% puzzle 0.0% 0.0% -0.0% -0.0% 0.0% queens 0.0% 0.0% -0.0% -0.0% +0.0% reptile 0.0% 0.0% -0.0% -0.0% 0.0% reverse-complem 0.0% 0.0% -0.0% -0.0% +0.0% rewrite 0.0% 0.0% -0.7% -2.5% -0.0% rfib 0.0% 0.0% -0.0% -0.0% 0.0% rsa 0.0% 0.0% -0.0% -0.0% 0.0% scc 0.0% 0.0% -0.1% -0.2% -0.0% sched 0.0% 0.0% -0.0% -0.0% -0.0% scs 0.0% 0.0% -1.0% -2.6% +0.0% simple 0.0% 0.0% +0.0% -0.0% +0.0% solid 0.0% 0.0% -0.0% -0.0% 0.0% sorting 0.0% 0.0% -0.6% -1.6% 0.0% spectral-norm 0.0% 0.0% +0.0% 0.0% +0.0% sphere 0.0% 0.0% -0.0% -0.0% -0.0% symalg 0.0% 0.0% -0.0% -0.0% +0.0% tak 0.0% 0.0% -0.0% -0.0% 0.0% transform 0.0% 0.0% -0.0% -0.0% 0.0% treejoin 0.0% 0.0% -0.0% -0.0% 0.0% typecheck 0.0% 0.0% -0.0% -0.0% +0.0% veritas +0.0% 0.0% -0.2% -0.4% +0.0% wang 0.0% 0.0% -0.0% -0.0% 0.0% wave4main 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve1 0.0% 0.0% -0.0% -0.0% -0.0% wheel-sieve2 0.0% 0.0% -0.0% -0.0% +0.0% x2n1 0.0% 0.0% -0.0% -0.0% -0.0% -------------------------------------------------------------------------------- Min 0.0% 0.0% -2.2% -5.4% -0.0% Max +0.0% 0.0% +0.0% +0.0% +0.1% Geometric Mean -0.0% -0.0% -0.1% -0.3% +0.0% Metric increases micro benchmarks tracked in #17686: Metric Increase: T12150 T12234 T12425 T13035 T5837 T6048 T9233 Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 3b22b14a by Shayne Fletcher at 2020-06-10T04:15:01-04:00 Give Language a Bounded instance - - - - - 9454511b by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Optimisation in Unique.Supply This patch switches on -fno-state-hack in GHC.Types.Unique.Supply. It turned out that my fixes for #18078 (coercion floating) changed the optimisation pathway for mkSplitUniqSupply in such a way that we had an extra allocation inside the inner loop. Adding -fno-state-hack fixed that -- and indeed the loop in mkSplitUniqSupply is a classic example of the way in which -fno-state-hack can be bad; see #18238. Moreover, the new code is better than the old. They allocate the same, but the old code ends up with a partial application. The net effect is that the test perf/should_run/UniqLoop runs 20% faster! From 2.5s down to 2.0s. The allocation numbers are the same -- but elapsed time falls. Good! The bad thing about this is that it's terribly delicate. But at least it's a good example of such delicacy in action. There is a long Note [Optimising the unique supply] which now explains all this. - - - - - 6d49d5be by Simon Peyton Jones at 2020-06-10T04:17:06-04:00 Implement cast worker/wrapper properly The cast worker/wrapper transformation transforms x = e |> co into y = e x = y |> co This is done by the simplifier, but we were being careless about transferring IdInfo from x to y, and about what to do if x is a NOINLNE function. This resulted in a series of bugs: #17673, #18093, #18078. This patch fixes all that: * Main change is in GHC.Core.Opt.Simplify, and the new prepareBinding function, which does this cast worker/wrapper transform. See Note [Cast worker/wrappers]. * There is quite a bit of refactoring around prepareRhs, makeTrivial etc. It's nicer now. * Some wrappers from strictness and cast w/w, notably those for a function with a NOINLINE, should inline very late. There wasn't really a mechanism for that, which was an existing bug really; so I invented a new finalPhase = Phase (-1). It's used for all simplifier runs after the user-visible phase 2,1,0 have run. (No new runs of the simplifier are introduced thereby.) See new Note [Compiler phases] in GHC.Types.Basic; the main changes are in GHC.Core.Opt.Driver * Doing this made me trip over two places where the AnonArgFlag on a FunTy was being lost so we could end up with (Num a -> ty) rather than (Num a => ty) - In coercionLKind/coercionRKind - In contHoleType in the Simplifier I fixed the former by defining mkFunctionType and using it in coercionLKind/RKind. I could have done the same for the latter, but the information is almost to hand. So I fixed the latter by - adding sc_hole_ty to ApplyToVal (like ApplyToTy), - adding as_hole_ty to ValArg (like TyArg) - adding sc_fun_ty to StrictArg Turned out I could then remove ai_type from ArgInfo. This is just moving the deck chairs around, but it worked out nicely. See the new Note [AnonArgFlag] in GHC.Types.Var * When looking at the 'arity decrease' thing (#18093) I discovered that stable unfoldings had a much lower arity than the actual optimised function. That's what led to the arity-decrease message. Simple solution: eta-expand. It's described in Note [Eta-expand stable unfoldings] in GHC.Core.Opt.Simplify * I also discovered that unsafeCoerce wasn't being inlined if the context was boring. So (\x. f (unsafeCoerce x)) would create a thunk -- yikes! I fixed that by making inlineBoringOK a bit cleverer: see Note [Inline unsafeCoerce] in GHC.Core.Unfold. I also found that unsafeCoerceName was unused, so I removed it. I made a test case for #18078, and a very similar one for #17673. The net effect of all this on nofib is very modest, but positive: -------------------------------------------------------------------------------- Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- anna -0.4% -0.1% -3.1% -3.1% 0.0% fannkuch-redux -0.4% -0.3% -0.1% -0.1% 0.0% maillist -0.4% -0.1% -7.8% -1.0% -14.3% primetest -0.4% -15.6% -7.1% -6.6% 0.0% -------------------------------------------------------------------------------- Min -0.9% -15.6% -13.3% -14.2% -14.3% Max -0.3% 0.0% +12.1% +12.4% 0.0% Geometric Mean -0.4% -0.2% -2.3% -2.2% -0.1% All following metric decreases are compile-time allocation decreases between -1% and -3%: Metric Decrease: T5631 T13701 T14697 T15164 - - - - - 32fd37f5 by Luke Lau at 2020-06-10T04:17:22-04:00 Fix lookupGlobalOccRn_maybe sometimes reporting an error In some cases it was possible for lookupGlobalOccRn_maybe to return an error, when it should be returning a Nothing. If it called lookupExactOcc_either when there were no matching GlobalRdrElts in the otherwise case, it would return an error message. This could be caused when lookupThName_maybe in Template Haskell was looking in different namespaces (thRdrNameGuesses), guessing different namespaces that the name wasn't guaranteed to be found in. However, by addressing this some more accurate errors were being lost in the conversion to Maybes. So some of the lookup* functions have been shuffled about so that errors should always be ignored in lookup*_maybes, and propagated otherwise. This fixes #18263 - - - - - 9b283e1b by Roland Senn at 2020-06-10T04:17:34-04:00 Initialize the allocation counter in GHCi to 0 (Fixes #16012) According to the documentation for the function `getAllocationCounter` in [System.Mem](http://hackage.haskell.org/package/base-4.14.0.0/docs/System-Mem.html) initialize the allocationCounter also in GHCi to 0. - - - - - 8d07c48c by Sylvain Henry at 2020-06-10T04:17:36-04:00 test: fix conc038 We had spurious failures of conc038 test on CI with stdout: ``` newThread started -mainThread -Haskell: 2 newThread back again +mainThread 1 sec later shutting down +Haskell: 2 ``` - - - - - 4c7e9689 by Sebastian Graf at 2020-06-11T10:37:38+02:00 Release Notes: Add news from the pattern-match checker [skip ci] - - - - - 3445b965 by Sylvain Henry at 2020-06-13T02:13:01-04:00 Only test T16190 with the NCG T16190 is meant to test a NCG feature. It has already caused spurious failures in other MRs (e.g. !2165) when LLVM is used. - - - - - 2517a51c by Sylvain Henry at 2020-06-13T02:13:01-04:00 DynFlags refactoring VIII (#17957) * Remove several uses of `sdocWithDynFlags`, especially in GHC.Llvm.* * Add LlvmOpts datatype to store Llvm backend options * Remove Outputable instances (for LlvmVar, LlvmLit, LlvmStatic and Llvm.MetaExpr) which require LlvmOpts. * Rename ppMetaExpr into ppMetaAnnotExpr (pprMetaExpr is now used in place of `ppr :: MetaExpr -> SDoc`) - - - - - 7a02599a by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove unused code - - - - - 72d08610 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor homeUnit * rename thisPackage into homeUnit * document and refactor several Backpack things - - - - - 8dc71f55 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Rename unsafeGetUnitInfo into unsafeLookupUnit - - - - - f6be6e43 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Add allowVirtualUnits field in PackageState Instead of always querying DynFlags to know whether we are allowed to use virtual units (i.e. instantiated on-the-fly, cf Note [About units] in GHC.Unit), we store it once for all in `PackageState.allowVirtualUnits`. This avoids using DynFlags too much (cf #17957) and is preliminary work for #14335. - - - - - e7272d53 by Sylvain Henry at 2020-06-13T02:13:02-04:00 Enhance UnitId use * use UnitId instead of String to identify wired-in units * use UnitId instead of Unit in the backend (Unit are only use by Backpack to produce type-checked interfaces, not real code) * rename lookup functions for consistency * documentation - - - - - 9c5572cd by Sylvain Henry at 2020-06-13T02:13:02-04:00 Remove LinkerUnitId type alias - - - - - d345edfe by Sylvain Henry at 2020-06-13T02:13:02-04:00 Refactor WiredMap * Remove WiredInUnitId and WiredUnitId type aliases - - - - - 3d171cd6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document and refactor `mkUnit` and `mkUnitInfoMap` - - - - - d2109b4f by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove PreloadUnitId type alias - - - - - f50c19b8 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename listUnitInfoMap into listUnitInfo There is no Map involved - - - - - ed533ec2 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit The terminology changed over time and now package databases contain "units" (there can be several units compiled from a single Cabal package: one per-component, one for each option set, one per instantiation, etc.). We should try to be consistent internally and use "units": that's what this renaming does. Maybe one day we'll fix the UI too (e.g. replace -package-id with -unit-id, we already have -this-unit-id and ghc-pkg has -unit-id...) but it's not done in this patch. * rename getPkgFrameworkOpts into getUnitFrameworkOpts * rename UnitInfoMap into ClosureUnitInfoMap * rename InstalledPackageIndex into UnitInfoMap * rename UnusablePackages into UnusableUnits * rename PackagePrecedenceIndex into UnitPrecedenceMap * rename PackageDatabase into UnitDatabase * rename pkgDatabase into unitDatabases * rename pkgState into unitState * rename initPackages into initUnits * rename renamePackage into renameUnitInfo * rename UnusablePackageReason into UnusableUnitReason * rename getPackage* into getUnit* * etc. - - - - - 202728e5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Make ClosureUnitInfoMap uses UnitInfoMap - - - - - 55b4263e by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove ClosureUnitInfoMap - - - - - 653d17bd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Rename Package into Unit (2) * rename PackageState into UnitState * rename findWiredInPackages into findWiredInUnits * rename lookupModuleInAll[Packages,Units] * etc. - - - - - ae900605 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move dump_mod_map into initUnits - - - - - 598cc1dd by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move wiring of homeUnitInstantiations outside of mkUnitState - - - - - 437265eb by Sylvain Henry at 2020-06-13T02:13:03-04:00 Avoid timing module map dump in initUnits - - - - - 9400aa93 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Remove preload parameter of mkUnitState * Remove preload parameter (unused) * Don't explicitly return preloaded units: redundant because already returned as "preloadUnits" field of UnitState - - - - - 266bc3d9 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: refactor unwireUnit - - - - - 9e715c1b by Sylvain Henry at 2020-06-13T02:13:03-04:00 Document getPreloadUnitsAnd - - - - - bd5810dc by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: remove useless add_package parameter - - - - - 36e1daf0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: make listVisibleModuleNames take a UnitState - - - - - 5226da37 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document add_package - - - - - 4b53aac1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Refactor and document closeUnitDeps - - - - - 42c054f6 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: findWiredInUnits - - - - - a444d01b by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: reportCycles, reportUnusable - - - - - 8408d521 by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: merge_databases - - - - - fca2d25f by Sylvain Henry at 2020-06-13T02:13:03-04:00 DynFlags: add UnitConfig datatype Avoid directly querying flags from DynFlags to build the UnitState. Instead go via UnitConfig so that we could reuse this to make another UnitState for plugins. - - - - - 4274688a by Sylvain Henry at 2020-06-13T02:13:03-04:00 Move distrustAll into mkUnitState - - - - - 28d804e1 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Create helper upd_wired_in_home_instantiations - - - - - ac964c83 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Put database cache in UnitConfig - - - - - bfd0a78c by Sylvain Henry at 2020-06-13T02:13:03-04:00 Don't return preload units when we set DyNFlags Preload units can be retrieved in UnitState when needed (i.e. in GHCi) - - - - - 1fbb4bf5 by Sylvain Henry at 2020-06-13T02:13:03-04:00 NCGConfig: remove useless ncgUnitId field - - - - - c10ff7e7 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Doc: fix some comments - - - - - 456e17f0 by Sylvain Henry at 2020-06-13T02:13:03-04:00 Bump haddock submodule and allow metric decrease Metric Decrease: T12150 T12234 T5837 Metric Increase: T16190 - - - - - 42953902 by Simon Peyton Jones at 2020-06-13T02:13:03-04:00 Trim the demand for recursive product types Ticket #18304 showed that we need to be very careful when exploring the demand (esp usage demand) on recursive product types. This patch solves the problem by trimming the demand on such types -- in effect, a form of "widening". See the Note [Trimming a demand to a type] in DmdAnal, which explains how I did this by piggy-backing on an existing mechansim for trimming demands becuase of GADTs. The significant payload of this patch is very small indeed: * Make GHC.Core.Opt.WorkWrap.Utils.typeShape use RecTcChecker to avoid looking through recursive types. But on the way * I found that ae_rec_tc was entirely inoperative and did nothing. So I removed it altogether from DmdAnal. * I moved some code around in DmdAnal and Demand. (There are no actual changes in dmdFix.) * I changed the API of DmsAnal.dmdAnalRhsLetDown to return a StrictSig rather than a decorated Id * I removed the dead function peelTsFuns from Demand Performance effects: Nofib: 0.0% changes. Not surprising, because they don't use recursive products Perf tests T12227: 1% increase in compiler allocation, becuase $cto gets w/w'd. It did not w/w before because it takes a deeply nested argument, so the worker gets too many args, so we abandon w/w altogether (see GHC.Core.Opt.WorkWrap.Utils.isWorkerSmallEnough) With this patch we trim the demands. That is not strictly necessary (since these Generic type constructors are like tuples -- they can't cause a loop) but the net result is that we now w/w $cto which is fine. UniqLoop: 16% decrease in /runtime/ allocation. The UniqSupply is a recursive product, so currently we abandon all strictness on 'churn'. With this patch 'churn' gets useful strictness, and we w/w it. Hooray Metric Decrease: UniqLoop Metric Increase: T12227 - - - - - 87d504f4 by Viktor Dukhovni at 2020-06-13T02:13:05-04:00 Add introductory prose for Data.Traversable - - - - - 9f09b608 by Oleg Grenrus at 2020-06-13T02:13:07-04:00 Fix #12073: Add MonadFix Q instance - - - - - 220c2d34 by Ben Gamari at 2020-06-13T02:13:07-04:00 testsuite: Increase size of T12150 As noted in #18319, this test was previously very fragile. Increase its size to make it more likely that its fails with its newly-increased acceptance threshold. Metric Increase: T12150 - - - - - 8bba1c26 by Ben Gamari at 2020-06-13T04:59:06-04:00 gitlab-ci: Always push perf notes Previously we ci.sh would run with `set -e` implying that we wouldn't push perf notes if the testsuite were to fail, even if it *only* failed due to perf notes. This rendered the whole performance testing story quite fragile as a single regressing commit would cause every successive commit to fail since a new baseline would not be uploaded. Fix this by ensuring that we always push performance notes. - - - - - 7a773f16 by Ben Gamari at 2020-06-13T15:10:55-04:00 gitlab-ci: Eliminate redundant push of CI metrics - - - - - a31218f7 by Ryan Scott at 2020-06-13T15:58:37-04:00 Use HsForAllTelescope to avoid inferred, visible foralls Currently, `HsForAllTy` permits the combination of `ForallVis` and `Inferred`, but you can't actually typecheck code that uses it (e.g., `forall {a} ->`). This patch refactors `HsForAllTy` to use a new `HsForAllTelescope` data type that makes a type-level distinction between visible and invisible `forall`s such that visible `forall`s do not track `Specificity`. That part of the patch is actually quite small; the rest is simply changing consumers of `HsType` to accommodate this new type. Fixes #18235. Bumps the `haddock` submodule. - - - - - c0e6dee9 by Tamar Christina at 2020-06-14T09:07:44-04:00 winio: Add Atomic Exchange PrimOp and implement Atomic Ptr exchanges. The initial version was rewritten by Tamar Christina. It was rewritten in large parts by Andreas Klebinger. Co-authored-by: Andreas Klebinger <klebinger.andreas at gmx.at> - - - - - 9a7462fb by Ben Gamari at 2020-06-14T15:35:23-04:00 codeGen: Don't discard live case binders in unsafeEqualityProof logic Previously CoreToStg would unconditionally discard cases of the form: case unsafeEqualityProof of wild { _ -> rhs } and rather replace the whole thing with `rhs`. However, in some cases (see #18227) the case binder is still live, resulting in unbound occurrences in `rhs`. Fix this by only discarding the case if the case binder is dead. Fixes #18227. - - - - - e4137c48 by Ben Gamari at 2020-06-14T15:35:23-04:00 testsuite: Add tests for #18227 T18227A is the original issue which gave rise to the ticket and depends upon bytestring. T18227B is a minimized reproducer. - - - - - 8bab9ff1 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Fix rts include and library paths Fixes two bugs: * (?) and (<>) associated in a surprising way * We neglected to include libdw paths in the rts configure flags - - - - - bd761185 by Ben Gamari at 2020-06-14T15:35:59-04:00 hadrian: Drop redundant GHC arguments Cabal should already be passing this arguments to GHC. - - - - - 01f7052c by Peter Trommler at 2020-06-14T15:36:38-04:00 FFI: Fix pass small ints in foreign call wrappers The Haskell calling convention requires integer parameters smaller than wordsize to be promoted to wordsize (where the upper bits are don't care). To access such small integer parameter read a word from the parameter array and then cast that word to the small integer target type. Fixes #15933 - - - - - 502647f7 by Krzysztof Gogolewski at 2020-06-14T15:37:14-04:00 Fix "ndecreasingIndentation" in manual (#18116) - - - - - 9a9cc089 by Simon Jakobi at 2020-06-15T13:10:00-04:00 Use foldl' in unionManyUniqDSets - - - - - 761dcb84 by Moritz Angermann at 2020-06-15T13:10:36-04:00 Load .lo as well. Some archives contain so called linker objects, with the affectionate .lo suffic. For example the musl libc.a will come in that form. We still want to load those objects, hence we should not discard them and look for .lo as well. Ultimately we might want to fix this proerly by looking at the file magic. - - - - - cf01477f by Vladislav Zavialov at 2020-06-15T13:11:20-04:00 User's Guide: KnownNat evidence is Natural This bit of documentation got outdated after commit 1fcede43d2b30f33b7505e25eb6b1f321be0407f - - - - - d0dcbfe6 by Jan Hrček at 2020-06-16T20:36:38+02:00 Fix typos and formatting in user guide - - - - - 56a9e95f by Jan Hrček at 2020-06-16T20:36:38+02:00 Resolve TODO - - - - - 3e884d14 by Jan Hrček at 2020-06-16T20:36:38+02:00 Rename TcHoleErrors to GHC.Tc.Errors.Hole - - - - - d23fc678 by Stefan Schulze Frielinghaus at 2020-06-17T15:31:09-04:00 hadrian: Build with threaded runtime if available See #16873. - - - - - 0639dc10 by Sylvain Henry at 2020-06-17T15:31:53-04:00 T16190: only measure bytes_allocated Just adding `{-# LANGUAGE BangPatterns #-}` makes the two other metrics fluctuate by 13%. - - - - - 4cab6897 by Adam Sandberg Ericsson at 2020-06-17T15:32:44-04:00 docs: fix formatting in users guide - - - - - eb8115a8 by Sylvain Henry at 2020-06-17T15:33:23-04:00 Move CLabel assertions into smart constructors (#17957) It avoids using DynFlags in the Outputable instance of Clabel to check assertions at pretty-printing time. - - - - - 7faa4509 by Ben Gamari at 2020-06-17T15:43:31-04:00 base: Bump to 4.15.0.0 - - - - - 20616959 by Ben Gamari at 2020-06-17T15:43:31-04:00 configure: Use grep -q instead of --quiet The latter is apparently not supported by busybox. - - - - - 40fa237e by Krzysztof Gogolewski at 2020-06-17T16:21:58-04:00 Linear types (#15981) This is the first step towards implementation of the linear types proposal (https://github.com/ghc-proposals/ghc-proposals/pull/111). It features * A language extension -XLinearTypes * Syntax for linear functions in the surface language * Linearity checking in Core Lint, enabled with -dlinear-core-lint * Core-to-core passes are mostly compatible with linearity * Fields in a data type can be linear or unrestricted; linear fields have multiplicity-polymorphic constructors. If -XLinearTypes is disabled, the GADT syntax defaults to linear fields The following items are not yet supported: * a # m -> b syntax (only prefix FUN is supported for now) * Full multiplicity inference (multiplicities are really only checked) * Decent linearity error messages * Linear let, where, and case expressions in the surface language (each of these currently introduce the unrestricted variant) * Multiplicity-parametric fields * Syntax for annotating lambda-bound or let-bound with a multiplicity * Syntax for non-linear/multiple-field-multiplicity records * Linear projections for records with a single linear field * Linear pattern synonyms * Multiplicity coercions (test LinearPolyType) A high-level description can be found at https://ghc.haskell.org/trac/ghc/wiki/LinearTypes/Implementation Following the link above you will find a description of the changes made to Core. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Matthew Pickering * Arnaud Spiwack With contributions from: * Mark Barbone * Alexander Vershilov Updates haddock submodule. - - - - - 6cb84c46 by Krzysztof Gogolewski at 2020-06-17T16:22:03-04:00 Various performance improvements This implements several general performance improvements to GHC, to offset the effect of the linear types change. General optimisations: - Add a `coreFullView` function which iterates `coreView` on the head. This avoids making function recursive solely because the iterate `coreView` themselves. As a consequence, this functions can be inlined, and trigger case-of-known constructor (_e.g._ `kindRep_maybe`, `isLiftedRuntimeRep`, `isMultiplicityTy`, `getTyVar_maybe`, `splitAppTy_maybe`, `splitFunType_maybe`, `tyConAppTyCon_maybe`). The common pattern about all these functions is that they are almost always used as views, and immediately consumed by a case expression. This commit also mark them asx `INLINE`. - In `subst_ty` add a special case for nullary `TyConApp`, which avoid allocations altogether. - Use `mkTyConApp` in `subst_ty` for the general `TyConApp`. This required quite a bit of module shuffling. case. `myTyConApp` enforces crucial sharing, which was lost during substitution. See also !2952 . - Make `subst_ty` stricter. - In `eqType` (specifically, in `nonDetCmpType`), add a special case, tested first, for the very common case of nullary `TyConApp`. `nonDetCmpType` has been made `INLINE` otherwise it is actually a regression. This is similar to the optimisations in !2952. Linear-type specific optimisations: - Use `tyConAppTyCon_maybe` instead of the more complex `eqType` in the definition of the pattern synonyms `One` and `Many`. - Break the `hs-boot` cycles between `Multiplicity.hs` and `Type.hs`: `Multiplicity` now import `Type` normally, rather than from the `hs-boot`. This way `tyConAppTyCon_maybe` can inline properly in the `One` and `Many` pattern synonyms. - Make `updateIdTypeAndMult` strict in its type and multiplicity - The `scaleIdBy` gets a specialised definition rather than being an alias to `scaleVarBy` - `splitFunTy_maybe` is given the type `Type -> Maybe (Mult, Type, Type)` instead of `Type -> Maybe (Scaled Type, Type)` - Remove the `MultMul` pattern synonym in favour of a view `isMultMul` because pattern synonyms appear not to inline well. - in `eqType`, in a `FunTy`, compare multiplicities last: they are almost always both `Many`, so it helps failing faster. - Cache `manyDataConTy` in `mkTyConApp`, to make sure that all the instances of `TyConApp ManyDataConTy []` are physically the same. This commit has been authored by * Richard Eisenberg * Krzysztof Gogolewski * Arnaud Spiwack Metric Decrease: haddock.base T12227 T12545 T12990 T1969 T3064 T5030 T9872b Metric Increase: haddock.base haddock.Cabal haddock.compiler T12150 T12234 T12425 T12707 T13035 T13056 T15164 T16190 T18304 T1969 T3064 T3294 T5631 T5642 T5837 T6048 T9020 T9233 T9675 T9872a T9961 WWRec - - - - - 57db91d8 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Remove integer-simple integer-simple uses lists of words (`[Word]`) to represent big numbers instead of ByteArray#: * it is less efficient than the newer ghc-bignum native backend * it isn't compatible with the big number representation that is now shared by all the ghc-bignum backends (based on the one that was used only in integer-gmp before). As a consequence, we simply drop integer-simple - - - - - 9f96bc12 by Sylvain Henry at 2020-06-17T16:22:03-04:00 ghc-bignum library ghc-bignum is a newer package that aims to replace the legacy integer-simple and integer-gmp packages. * it supports several backends. In particular GMP is still supported and most of the code from integer-gmp has been merged in the "gmp" backend. * the pure Haskell "native" backend is new and is much faster than the previous pure Haskell implementation provided by integer-simple * new backends are easier to write because they only have to provide a few well defined functions. All the other code is common to all backends. In particular they all share the efficient small/big number distinction previously used only in integer-gmp. * backends can all be tested against the "native" backend with a simple Cabal flag. Backends are only allowed to differ in performance, their results should be the same. * Add `integer-gmp` compat package: provide some pattern synonyms and function aliases for those in `ghc-bignum`. It is intended to avoid breaking packages that depend on `integer-gmp` internals. Update submodules: text, bytestring Metric Decrease: Conversions ManyAlternatives ManyConstructors Naperian T10359 T10547 T10678 T12150 T12227 T12234 T12425 T13035 T13719 T14936 T1969 T4801 T4830 T5237 T5549 T5837 T8766 T9020 parsing001 space_leak_001 T16190 haddock.base On ARM and i386, T17499 regresses (+6% > 5%). On x86_64 unregistered, T13701 sometimes regresses (+2.2% > 2%). Metric Increase: T17499 T13701 - - - - - 96aa5787 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update compiler Thanks to ghc-bignum, the compiler can be simplified: * Types and constructors of Integer and Natural can be wired-in. It means that we don't have to query them from interfaces. It also means that numeric literals don't have to carry their type with them. * The same code is used whatever ghc-bignum backend is enabled. In particular, conversion of bignum literals into final Core expressions is now much more straightforward. Bignum closure inspection too. * GHC itself doesn't depend on any integer-* package anymore * The `integerLibrary` setting is gone. - - - - - 0f67e344 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `base` package * GHC.Natural isn't implemented in `base` anymore. It is provided by ghc-bignum in GHC.Num.Natural. It means that we can safely use Natural primitives in `base` without fearing issues with built-in rewrite rules (cf #15286) * `base` doesn't conditionally depend on an integer-* package anymore, it depends on ghc-bignum * Some duplicated code in integer-* can now be factored in GHC.Float * ghc-bignum tries to use a uniform naming convention so most of the other changes are renaming - - - - - aa9e7b71 by Sylvain Henry at 2020-06-17T16:22:03-04:00 Update `make` based build system * replace integer-* package selection with ghc-bignum backend selection - - - - - f817d816 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update testsuite * support detection of slow ghc-bignum backend (to replace the detection of integer-simple use). There are still some test cases that the native backend doesn't handle efficiently enough. * remove tests for GMP only functions that have been removed from ghc-bignum * fix test results showing dependent packages (e.g. integer-gmp) or showing suggested instances * fix test using Integer/Natural API or showing internal names - - - - - dceecb09 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Update Hadrian * support ghc-bignum backend selection in flavours and command-line * support ghc-bignum "--check" flag (compare results of selected backend against results of the native one) in flavours and command-line (e.g. pass --bignum=check-gmp" to check the "gmp" backend) * remove the hack to workaround #15286 * build GMP only when the gmp backend is used * remove hacks to workaround `text` package flags about integer-*. We fix `text` to use ghc-bignum unconditionally in another patch - - - - - fa4281d6 by Sylvain Henry at 2020-06-17T16:22:04-04:00 Bump bytestring and text submodules - - - - - 1a3f6f34 by Adam Sandberg Ericsson at 2020-06-18T23:03:36-04:00 docs: mention -hiedir in docs for -outputdir [skip ci] - - - - - 729bcb02 by Sylvain Henry at 2020-06-18T23:04:17-04:00 Hadrian: fix build on Mac OS Catalina (#17798) - - - - - 95e18292 by Andreas Klebinger at 2020-06-18T23:04:58-04:00 Relax allocation threshold for T12150. This test performs little work, so the most minor allocation changes often cause the test to fail. Increasing the threshold to 2% should help with this. - - - - - 8ce6c393 by Sebastian Graf at 2020-06-18T23:05:36-04:00 hadrian: Bump pinned cabal.project to an existent index-state - - - - - 08c1cb0f by Ömer Sinan Ağacan at 2020-06-18T23:06:21-04:00 Fix uninitialized field read in Linker.c Valgrind report of the bug when running the test `linker_unload`: ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x36C027A: loadArchive_ (LoadArchive.c:522) ==29666== by 0x36C0600: loadArchive (LoadArchive.c:626) ==29666== by 0x2C144CD: ??? (in /home/omer/haskell/ghc_2/testsuite/tests/rts/linker/linker_unload.run/linker_unload) ==29666== ==29666== Conditional jump or move depends on uninitialised value(s) ==29666== at 0x369C5B4: setOcInitialStatus (Linker.c:1305) ==29666== by 0x369C6C5: mkOc (Linker.c:1347) ==29666== by 0x369C9F6: preloadObjectFile (Linker.c:1507) ==29666== by 0x369CA8D: loadObj_ (Linker.c:1536) ==29666== by 0x369CB17: loadObj (Linker.c:1557) ==29666== by 0x3866BC: main (linker_unload.c:33) The problem is `mkOc` allocates a new `ObjectCode` and calls `setOcInitialStatus` without initializing the `status` field. `setOcInitialStatus` reads the field as first thing: static void setOcInitialStatus(ObjectCode* oc) { if (oc->status == OBJECT_DONT_RESOLVE) return; if (oc->archiveMemberName == NULL) { oc->status = OBJECT_NEEDED; } else { oc->status = OBJECT_LOADED; } } `setOcInitialStatus` is unsed in two places for two different purposes: in `mkOc` where we don't have the `status` field initialized yet (`mkOc` is supposed to initialize it), and `loadOc` where we do have `status` field initialized and we want to update it. Instead of splitting the function into two functions which are both called just once I inline the functions in the use sites and remove it. Fixes #18342 - - - - - da18ff99 by Tamar Christina at 2020-06-18T23:07:03-04:00 fix windows bootstrap due to linker changes - - - - - 2af0ec90 by Sylvain Henry at 2020-06-18T23:07:47-04:00 DynFlags: store default depth in SDocContext (#17957) It avoids having to use DynFlags to reach for pprUserLength. - - - - - d4a0be75 by Sylvain Henry at 2020-06-18T23:08:35-04:00 Move tablesNextToCode field into Platform tablesNextToCode is a platform setting and doesn't belong into DynFlags (#17957). Doing this is also a prerequisite to fix #14335 where we deal with two platforms (target and host) that may have different platform settings. - - - - - 809caedf by John Ericson at 2020-06-23T22:47:37-04:00 Switch from HscSource to IsBootInterface for module lookup in GhcMake We look up modules by their name, and not their contents. There is no way to separately reference a signature vs regular module; you get what you get. Only boot files can be referenced indepenently with `import {-# SOURCE #-}`. - - - - - 7750bd45 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Cmm: introduce SAVE_REGS/RESTORE_REGS We don't want to save both Fn and Dn register sets on x86-64 as they are aliased to the same arch register (XMMn). Moreover, when SAVE_STGREGS was used in conjunction with `jump foo [*]` which makes a set of Cmm registers alive so that they cover all arch registers used to pass parameter, we could have Fn, Dn and XMMn alive at the same time. It made the LLVM code generator choke (see #17920). Now `SAVE_REGS/RESTORE_REGS` and `jump foo [*]` use the same set of registers. - - - - - 2636794d by Sylvain Henry at 2020-06-23T22:48:18-04:00 CmmToC: don't add extern decl to parsed Cmm data Previously, if a .cmm file *not in the RTS* contained something like: ```cmm section "rodata" { msg : bits8[] "Test\n"; } ``` It would get compiled by CmmToC into: ```c ERW_(msg); const char msg[] = "Test\012"; ``` and fail with: ``` /tmp/ghc32129_0/ghc_4.hc:5:12: error: error: conflicting types for \u2018msg\u2019 const char msg[] = "Test\012"; ^~~ In file included from /tmp/ghc32129_0/ghc_4.hc:3:0: error: /tmp/ghc32129_0/ghc_4.hc:4:6: error: note: previous declaration of \u2018msg\u2019 was here ERW_(msg); ^ /builds/hsyl20/ghc/_build/install/lib/ghc-8.11.0.20200605/lib/../lib/x86_64-linux-ghc-8.11.0.20200605/rts-1.0/include/Stg.h:253:46: error: note: in definition of macro \u2018ERW_\u2019 #define ERW_(X) extern StgWordArray (X) ^ ``` See the rationale for this on https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler/backends/ppr-c#prototypes Now we don't generate these extern declarations (ERW_, etc.) for top-level data. It shouldn't change anything for the RTS (the only place we use .cmm files) as it is already special cased in `GHC.Cmm.CLabel.needsCDecl`. And hand-written Cmm can use explicit extern declarations when needed. Note that it allows `cgrun069` test to pass with CmmToC (cf #15467). - - - - - 5f6a0665 by Sylvain Henry at 2020-06-23T22:48:18-04:00 LLVM: refactor and comment register padding code (#17920) - - - - - cad62ef1 by Sylvain Henry at 2020-06-23T22:48:18-04:00 Add tests for #17920 Metric Decrease: T12150 T12234 - - - - - a2a9006b by Xavier Denis at 2020-06-23T22:48:56-04:00 Fix issue #18262 by zonking constraints after solving Zonk residual constraints in checkForExistence to reveal user type errors. Previously when `:instances` was used with instances that have TypeError constraints the result would look something like: instance [safe] s0 => Err 'A -- Defined at ../Bug2.hs:8:10 whereas after zonking, `:instances` now sees the `TypeError` and properly eliminates the constraint from the results. - - - - - 181516bc by Simon Peyton Jones at 2020-06-23T22:49:33-04:00 Fix a buglet in Simplify.simplCast This bug, revealed by #18347, is just a missing update to sc_hole_ty in simplCast. I'd missed a code path when I made the recentchanges in commit 6d49d5be904c0c01788fa7aae1b112d5b4dfaf1c Author: Simon Peyton Jones <simonpj at microsoft.com> Date: Thu May 21 12:53:35 2020 +0100 Implement cast worker/wrapper properly The fix is very easy. Two other minor changes * Tidy up in SimpleOpt.simple_opt_expr. In fact I think this is an outright bug, introduced in the fix to #18112: we were simplifying the same coercion twice *with the same substitution*, which is just wrong. It'd be a hard bug to trigger, so I just fixed it; less code too. * Better debug printing of ApplyToVal - - - - - 625a7f54 by Simon Peyton Jones at 2020-06-23T22:50:11-04:00 Two small tweaks to Coercion.simplifyArgsWorker These tweaks affect the inner loop of simplifyArgsWorker, which in turn is called from the flattener in Flatten.hs. This is a key perf bottleneck to T9872{a,b,c,d}. These two small changes have a modest but useful benefit. No change in functionality whatsoever. Relates to #18354 - - - - - b5768cce by Sylvain Henry at 2020-06-23T22:50:49-04:00 Don't use timesInt2# with GHC < 8.11 (fix #18358) - - - - - 7ad4085c by Sylvain Henry at 2020-06-23T22:51:27-04:00 Fix invalid printf format - - - - - a1f34d37 by Krzysztof Gogolewski at 2020-06-23T22:52:09-04:00 Add missing entry to freeNamesItem (#18369) - - - - - 03a708ba by Andreas Klebinger at 2020-06-25T03:54:37-04:00 Enable large address space optimization on windows. Starting with Win 8.1/Server 2012 windows no longer preallocates page tables for reserverd memory eagerly, which prevented us from using this approach in the past. We also try to allocate the heap high in the memory space. Hopefully this makes it easier to allocate things in the low 4GB of memory that need to be there. Like jump islands for the linker. - - - - - 7e6d3d09 by Roland Senn at 2020-06-25T03:54:38-04:00 In `:break ident` allow out of scope and nested identifiers (Fix #3000) This patch fixes the bug and implements the feature request of #3000. 1. If `Module` is a real module name and `identifier` a name of a top-level function in `Module` then `:break Module.identifer` works also for an `identifier` that is out of scope. 2. Extend the syntax for `:break identifier` to: :break [ModQual.]topLevelIdent[.nestedIdent]...[.nestedIdent] `ModQual` is optional and is either the effective name of a module or the local alias of a qualified import statement. `topLevelIdent` is the name of a top level function in the module referenced by `ModQual`. `nestedIdent` is optional and the name of a function nested in a let or where clause inside the previously mentioned function `nestedIdent` or `topLevelIdent`. If `ModQual` is a module name, then `topLevelIdent` can be any top level identifier in this module. If `ModQual` is missing or a local alias of a qualified import, then `topLevelIdent` must be in scope. Breakpoints can be set on arbitrarily deeply nested functions, but the whole chain of nested function names must be specified. 3. To support the new functionality rewrite the code to tab complete `:break`. - - - - - 30e42652 by Ben Gamari at 2020-06-25T03:54:39-04:00 make: Respect XELATEX variable Previously we simply ignored the XELATEX variable when building PDF documentation. - - - - - 4acc2934 by Ben Gamari at 2020-06-25T03:54:39-04:00 hadrian/make: Detect makeindex Previously we would simply assume that makeindex was available. Now we correctly detect it in `configure` and respect this conclusion in hadrian and make. - - - - - 0d61f866 by Simon Peyton Jones at 2020-06-25T03:54:40-04:00 Expunge GhcTcId GHC.Hs.Extension had type GhcPs = GhcPass 'Parsed type GhcRn = GhcPass 'Renamed type GhcTc = GhcPass 'Typechecked type GhcTcId = GhcTc The last of these, GhcTcId, is a vestige of the past. This patch expunges it from GHC. - - - - - 8ddbed4a by Adam Wespiser at 2020-06-25T03:54:40-04:00 add examples to Data.Traversable - - - - - 284001d0 by Oleg Grenrus at 2020-06-25T03:54:42-04:00 Export readBinIface_ - - - - - 90f43872 by Zubin Duggal at 2020-06-25T03:54:43-04:00 Export everything from HsToCore. This lets us reuse these functions in haddock, avoiding synchronization bugs. Also fixed some divergences with haddock in that file Updates haddock submodule - - - - - c7dd6da7 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part1) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Hs.* - GHC.Core.* - GHC.Stg.* - GHC.Cmm.* - GHC.Types.* - GHC.Data.* - GHC.Builtin.* - GHC.Parser.* - GHC.Driver.* - GHC top - - - - - 1eb997a8 by Takenobu Tani at 2020-06-25T03:54:44-04:00 Clean up haddock hyperlinks of GHC.* (part2) This updates haddock comments only. This patch focuses to update for hyperlinks in GHC API's haddock comments, because broken links especially discourage newcomers. This includes the following hierarchies: - GHC.Iface.* - GHC.Llvm.* - GHC.Rename.* - GHC.Tc.* - GHC.HsToCore.* - GHC.StgToCmm.* - GHC.CmmToAsm.* - GHC.Runtime.* - GHC.Unit.* - GHC.Utils.* - GHC.SysTools.* - - - - - 67a86b4d by Oleg Grenrus at 2020-06-25T03:54:46-04:00 Add MonadZip and MonadFix instances for Complex These instances are taken from https://hackage.haskell.org/package/linear-1.21/docs/Linear-Instances.html They are the unique possible, so let they be in `base`. - - - - - c50ef26e by Artem Pelenitsyn at 2020-06-25T03:54:47-04:00 test suite: add reproducer for #17516 - - - - - fe281b27 by Roland Senn at 2020-06-25T03:54:48-04:00 Enable maxBound checks for OverloadedLists (Fixes #18172) Consider the Literal `[256] :: [Data.Word.Word8]` When the `OverloadedLists` extension is not active, then the `ol_ext` field in the `OverLitTc` record that is passed to the function `getIntegralLit` contains the type `Word8`. This is a simple type, and we can use its type constructor immediately for the `warnAboutOverflowedLiterals` function. When the `OverloadedLists` extension is active, then the `ol_ext` field contains the type family `Item [Word8]`. The function `nomaliseType` is used to convert it to the needed type `Word8`. - - - - - a788d4d1 by Ben Gamari at 2020-06-25T03:54:52-04:00 rts/Hash: Simplify freeing of HashListChunks While looking at #18348 I noticed that the treatment of HashLists are a bit more complex than necessary (which lead to some initial confusion on my part). Specifically, we allocate HashLists in chunks. Each chunk allocation makes two allocations: one for the chunk itself and one for a HashListChunk to link together the chunks for the purposes of freeing. Simplify this (and hopefully make the relationship between these clearer) but allocating the HashLists and HashListChunk in a single malloc. This will both make the implementation easier to follow and reduce C heap fragmentation. Note that even after this patch we fail to bound the size of the free HashList pool. However, this is a separate bug. - - - - - d3c2d59b by Sylvain Henry at 2020-06-25T03:54:55-04:00 RTS: avoid overflow on 32-bit arch (#18375) We're now correctly computing allocated bytes on 32-bit arch, so we get huge increases. Metric Increase: haddock.Cabal haddock.base haddock.compiler space_leak_001 - - - - - a3d69dc6 by Sebastian Graf at 2020-06-25T23:06:18-04:00 GHC.Core.Unify: Make UM actions one-shot by default This MR makes the UM monad in GHC.Core.Unify into a one-shot monad. See the long Note [The one-shot state monad trick]. See also #18202 and !3309, which applies this to all Reader/State-like monads in GHC for compile-time perf improvements. The pattern used here enables something similar to the state-hack, but is applicable to user-defined monads, not just `IO`. Metric Decrease 'runtime/bytes allocated' (test_env='i386-linux-deb9'): haddock.Cabal - - - - - 9ee58f8d by Matthias Pall Gissurarson at 2020-06-26T17:12:45+00:00 Implement the proposed -XQualifiedDo extension Co-authored-by: Facundo Domínguez <facundo.dominguez at tweag.io> QualifiedDo is implemented using the same placeholders for operation names in the AST that were devised for RebindableSyntax. Whenever the renamer checks which names to use for do syntax, it first checks if the do block is qualified (e.g. M.do { stmts }), in which case it searches for qualified names in the module M. This allows users to write {-# LANGUAGE QualifiedDo #-} import qualified SomeModule as M f x = M.do -- desugars to: y <- M.return x -- M.return x M.>>= \y -> M.return y -- M.return y M.>> M.return y -- M.return y See Note [QualifiedDo] and the users' guide for more details. Issue #18214 Proposal: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0216-qualified-do.rst Since we change the constructors `ITdo` and `ITmdo` to carry the new module name, we need to bump the haddock submodule to account or the new shape of these constructors. - - - - - ce987865 by Ryan Scott at 2020-06-27T11:55:21-04:00 Revamp the treatment of auxiliary bindings for derived instances This started as a simple fix for #18321 that organically grew into a much more sweeping refactor of how auxiliary bindings for derived instances are handled. I have rewritten `Note [Auxiliary binders]` in `GHC.Tc.Deriv.Generate` to explain all of the moving parts, but the highlights are: * Previously, the OccName of each auxiliary binding would be given a suffix containing a hash of its package name, module name, and parent data type to avoid name clashes. This was needlessly complicated, so we take the more direct approach of generating `Exact` `RdrName`s for each auxiliary binding with the same `OccName`, but using an underlying `System` `Name` with a fresh `Unique` for each binding. Unlike hashes, allocating new `Unique`s does not require any cleverness and avoid name clashes all the same... * ...speaking of which, in order to convince the renamer that multiple auxiliary bindings with the same `OccName` (but different `Unique`s) are kosher, we now use `rnLocalValBindsLHS` instead of `rnTopBindsLHS` to rename auxiliary bindings. Again, see `Note [Auxiliary binders]` for the full story. * I have removed the `DerivHsBind` constructor for `DerivStuff`—which was only used for `Data.Data`-related auxiliary bindings—and refactored `gen_Data_binds` to use `DerivAuxBind` instead. This brings the treatment of `Data.Data`-related auxiliary bindings in line with every other form of auxiliary binding. Fixes #18321. - - - - - a403eb91 by Sylvain Henry at 2020-06-27T11:55:59-04:00 ghc-bignum: fix division by zero (#18359) - - - - - 1b3d13b6 by Sylvain Henry at 2020-06-27T11:55:59-04:00 Fix ghc-bignum exceptions We must ensure that exceptions are not simplified. Previously we used: case raiseDivZero of _ -> 0## -- dummyValue But it was wrong because the evaluation of `raiseDivZero` was removed and the dummy value was directly returned. See new Note [ghc-bignum exceptions]. I've also removed the exception triggering primops which were fragile. We don't need them to be primops, we can have them exported by ghc-prim. I've also added a test for #18359 which triggered this patch. - - - - - a74ec37c by Simon Peyton Jones at 2020-06-27T11:56:34-04:00 Better loop detection in findTypeShape Andreas pointed out, in !3466, that my fix for #18304 was not quite right. This patch fixes it properly, by having just one RecTcChecker rather than (implicitly) two nested ones, in findTypeShape. - - - - - a04020b8 by Sylvain Henry at 2020-06-27T11:57:11-04:00 DynFlags: don't store buildTag `DynFlags.buildTag` was a field created from the set of Ways in `DynFlags.ways`. It had to be kept in sync with `DynFlags.ways` which was fragile. We want to avoid global state like this (#17957). Moreover in #14335 we also want to support loading units with different ways: target units would still use `DynFlags.ways` but plugins would use `GHC.Driver.Ways.hostFullWays`. To avoid having to deal both with build tag and with ways, we recompute the buildTag on-the-fly (should be pretty cheap) and we remove `DynFlags.buildTag` field. - - - - - 0e83efa2 by Krzysztof Gogolewski at 2020-06-27T11:57:49-04:00 Don't generalize when typechecking a tuple section The code is simpler and cleaner. - - - - - d8ba9e6f by Peter Trommler at 2020-06-28T09:19:11-04:00 RTS: Refactor Haskell-C glue for PPC 64-bit Make sure the stack is 16 byte aligned even when reserved stack bytes are not a multiple of 16 bytes. Avoid saving r2 (TOC). On ELF v1 the function descriptor of StgReturn has the same TOC as StgRun, on ELF v2 the TOC is recomputed in the function prologue. Use the ABI provided functions to save clobbered GPRs and FPRs. Improve comments. Describe what the stack looks like and how it relates to the respective ABIs. - - - - - 42f797b0 by Ryan Scott at 2020-06-28T09:19:46-04:00 Use NHsCoreTy to embed types into GND-generated code `GeneralizedNewtypeDeriving` is in the unique situation where it must produce an `LHsType GhcPs` from a Core `Type`. Historically, this was done with the `typeToLHsType` function, which walked over the entire `Type` and attempted to construct an `LHsType` with the same overall structure. `typeToLHsType` is quite complicated, however, and has been the subject of numerous bugs over the years (e.g., #14579). Luckily, there is an easier way to accomplish the same thing: the `XHsType` constructor of `HsType`. `XHsType` bundles an `NHsCoreTy`, which allows embedding a Core `Type` directly into an `HsType`, avoiding the need to laboriously convert from one to another (as `typeToLHsType` did). Moreover, renaming and typechecking an `XHsType` is simple, since one doesn't need to do anything to a Core `Type`... ...well, almost. For the reasons described in `Note [Typechecking NHsCoreTys]` in `GHC.Tc.Gen.HsType`, we must apply a substitution that we build from the local `tcl_env` type environment. But that's a relatively modest price to pay. Now that `GeneralizedNewtypeDeriving` uses `NHsCoreTy`, the `typeToLHsType` function no longer has any uses in GHC, so this patch rips it out. Some additional tweaks to `hsTypeNeedsParens` were necessary to make the new `-ddump-deriv` output correctly parenthesized, but other than that, this patch is quite straightforward. This is a mostly internal refactoring, although it is likely that `GeneralizedNewtypeDeriving`-generated code will now need fewer language extensions in certain situations than it did before. - - - - - 68530b1c by Jan Hrček at 2020-06-28T09:20:22-04:00 Fix duplicated words and typos in comments and user guide - - - - - 15b79bef by Ryan Scott at 2020-06-28T09:20:57-04:00 Add integer-gmp's ghc.mk and GNUmakefile to .gitignore - - - - - bfa5698b by Simon Peyton Jones at 2020-06-28T09:21:32-04:00 Fix a typo in Lint This simple error in GHC.Core.Litn.lintJoinLams meant that Lint reported bogus errors. Fixes #18399 - - - - - 71006532 by Ryan Scott at 2020-06-30T07:10:42-04:00 Reject nested foralls/contexts in instance types more consistently GHC is very wishy-washy about rejecting instance declarations with nested `forall`s or contexts that are surrounded by outermost parentheses. This can even lead to some strange interactions with `ScopedTypeVariables`, as demonstrated in #18240. This patch makes GHC more consistently reject instance types with nested `forall`s/contexts so as to prevent these strange interactions. On the implementation side, this patch tweaks `splitLHsInstDeclTy` and `getLHsInstDeclHead` to not look through parentheses, which can be semantically significant. I've added a `Note [No nested foralls or contexts in instance types]` in `GHC.Hs.Type` to explain why. This also introduces a `no_nested_foralls_contexts_err` function in `GHC.Rename.HsType` to catch nested `forall`s/contexts in instance types. This function is now used in `rnClsInstDecl` (for ordinary instance declarations) and `rnSrcDerivDecl` (for standalone `deriving` declarations), the latter of which fixes #18271. On the documentation side, this adds a new "Formal syntax for instance declaration types" section to the GHC User's Guide that presents a BNF-style grammar for what is and isn't allowed in instance types. Fixes #18240. Fixes #18271. - - - - - bccf3351 by Sylvain Henry at 2020-06-30T07:10:46-04:00 Add ghc-bignum to 8.12 release notes - - - - - 81704a6f by David Eichmann at 2020-06-30T07:10:48-04:00 Update ssh keys in CI performance metrics upload script - - - - - 85310fb8 by Joshua Price at 2020-06-30T07:10:49-04:00 Add missing Ix instances for tuples of size 6 through 15 (#16643) - - - - - cbb6b62f by Vladislav Zavialov at 2020-07-01T15:41:38-04:00 Implement -XLexicalNegation (GHC Proposal #229) This patch introduces a new extension, -XLexicalNegation, which detects whether the minus sign stands for negation or subtraction using the whitespace-based rules described in GHC Proposal #229. Updates haddock submodule. - - - - - fb5a0d01 by Martin Handley at 2020-07-01T15:42:14-04:00 #17169: Clarify Fixed's Enum instance. - - - - - b316804d by Simon Peyton Jones at 2020-07-01T15:42:49-04:00 Improve debug tracing for substitution This patch improves debug tracing a bit (#18395) * Remove the ancient SDoc argument to substitution, replacing it with a HasDebugCallStack constraint. The latter does the same job (indicate the call site) but much better. * Add HasDebugCallStack to simpleOptExpr, exprIsConApp_maybe I needed this to help nail the lookupIdSubst panic in #18326, #17784 - - - - - 5c9fabb8 by Hécate at 2020-07-01T15:43:25-04:00 Add most common return values for `os` and `arch` - - - - - 76d8cc74 by Ryan Scott at 2020-07-01T15:44:01-04:00 Desugar quoted uses of DerivingVia and expression type signatures properly The way that `GHC.HsToCore.Quote` desugared quoted `via` types (e.g., `deriving via forall a. [a] instance Eq a => Eq (List a)`) and explicit type annotations in signatures (e.g., `f = id @a :: forall a. a -> a`) was completely wrong, as it did not implement the scoping guidelines laid out in `Note [Scoped type variables in bindings]`. This is easily fixed. While I was in town, I did some minor cleanup of related Notes: * `Note [Scoped type variables in bindings]` and `Note [Scoped type variables in class and instance declarations]` say very nearly the same thing. I decided to just consolidate the two Notes into `Note [Scoped type variables in quotes]`. * `Note [Don't quantify implicit type variables in quotes]` is somewhat outdated, as it predates GHC 8.10, where the `forall`-or-nothing rule requires kind variables to be explicitly quantified in the presence of an explicit `forall`. As a result, the running example in that Note doesn't even compile. I have changed the example to something simpler that illustrates the same point that the original Note was making. Fixes #18388. - - - - - 44d6a335 by Andreas Klebinger at 2020-07-02T02:54:54-04:00 T16012: Be verbose on failure. - - - - - f9853330 by Ryan Scott at 2020-07-02T02:55:29-04:00 Bump ghc-prim version to 0.7.0 Fixes #18279. Bumps the `text` submodule. - - - - - 23e4e047 by Sylvain Henry at 2020-07-02T10:46:31-04:00 Hadrian: fix PowerPC64le support (#17601) [ci skip] - - - - - 3cdd8d69 by Sylvain Henry at 2020-07-02T10:47:08-04:00 NCG: correctly handle addresses with huge offsets (#15570) Before this patch we could generate addresses of this form: movzbl cP0_str+-9223372036854775808,%eax The linker can't handle them because the offset is too large: ld.lld: error: Main.o:(.text+0xB3): relocation R_X86_64_32S out of range: -9223372036852653050 is not in [-2147483648, 2147483647] With this patch we detect those cases and generate: movq $-9223372036854775808,%rax addq $cP0_str,%rax movzbl (%rax),%eax I've also refactored `getAmode` a little bit to make it easier to understand and to trace. - - - - - 4d90b3ff by Gabor Greif at 2020-07-02T20:07:59-04:00 No need for CURSES_INCLUDE_DIRS This is a leftover from ef63ff27251a20ff11e58c9303677fa31e609a88 - - - - - f08d6316 by Sylvain Henry at 2020-07-02T20:08:36-04:00 Replace Opt_SccProfilingOn flag with sccProfilingEnabled helper function SCC profiling was enabled in a convoluted way: if WayProf was enabled, Opt_SccProfilingOn general flag was set (in `GHC.Driver.Ways.wayGeneralFlags`), and then this flag was queried in various places. There is no need to go via general flags, so this patch defines a `sccProfilingEnabled :: DynFlags -> Bool` helper function that just checks whether WayProf is enabled. - - - - - 8cc7274b by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Only allocate the Censuses that we need When not LDV profiling there is no reason to allocate 32 Censuses; one will do. This is a very small memory footprint optimisation, but it comes for free. - - - - - b835112c by Ben Gamari at 2020-07-03T02:49:27-04:00 rts/ProfHeap: Free old allocations when reinitialising Censuses Previously when not LDV profiling we would repeatedly reinitialise `censuses[0]` with `initEra`. This failed to free the `Arena` and `HashTable` from the old census, resulting in a memory leak. Fixes #18348. - - - - - 34be6523 by Valery Tolstov at 2020-07-03T02:50:03-04:00 Mention flags that are not enabled by -Wall (#18372) * Mention missing flags that are not actually enabled by -Wall (docs/users_guide/using-warnings.rst) * Additionally remove -Wmissing-monadfail-instances from the list of flags enabled by -Wcompat, as it is not the case since 8.8 - - - - - edc8d22b by Sylvain Henry at 2020-07-03T02:50:40-04:00 LLVM: support R9 and R10 registers d535ef006d85dbdb7cda2b09c5bc35cb80108909 allowed the use of up to 10 vanilla registers but didn't update LLVM backend to support them. This patch fixes it. - - - - - 4bf18646 by Simon Peyton Jones at 2020-07-03T08:37:42+01:00 Improve handling of data type return kinds Following a long conversation with Richard, this patch tidies up the handling of return kinds for data/newtype declarations (vanilla, family, and instance). I have substantially edited the Notes in TyCl, so they would bear careful reading. Fixes #18300, #18357 In GHC.Tc.Instance.Family.newFamInst we were checking some Lint-like properties with ASSSERT. Instead Richard and I have added a proper linter for axioms, and called it from lintGblEnv, which in turn is called in tcRnModuleTcRnM New tests (T18300, T18357) cause an ASSERT failure in HEAD. - - - - - 41d26492 by Sylvain Henry at 2020-07-03T17:33:59-04:00 DynFlags: avoid the use of sdocWithDynFlags in GHC.Core.Rules (#17957) - - - - - 7aa6ef11 by Hécate at 2020-07-03T17:34:36-04:00 Add the __GHC_FULL_VERSION__ CPP macro to expose the full GHC version - - - - - e61d5395 by Chaitanya Koparkar at 2020-07-07T13:55:59-04:00 ghc-prim: Turn some comments into haddocks [ci skip] - - - - - 37743f91 by John Ericson at 2020-07-07T13:56:00-04:00 Support `timesInt2#` in LLVM backend - - - - - 46397e53 by John Ericson at 2020-07-07T13:56:00-04:00 `genericIntMul2Op`: Call `genericWordMul2Op` directly This unblocks a refactor, and removes partiality. It might be a PowerPC regression but that should be fixable. - - - - - 8a1c0584 by John Ericson at 2020-07-07T13:56:00-04:00 Simplify `PrimopCmmEmit` Follow @simonpj's suggestion of pushing the "into regs" logic into `emitPrimOp`. With the previous commit getting rid of the recursion in `genericIntMul2Op`, this is now an easy refactor. - - - - - 6607f203 by John Ericson at 2020-07-07T13:56:00-04:00 `opAllDone` -> `opIntoRegs` The old name was and terrible and became worse after the previous commit's refactor moved non-trivial funcationlity into its body. - - - - - fdcc53ba by Sylvain Henry at 2020-07-07T13:56:00-04:00 Optimise genericIntMul2Op We shouldn't directly call 'genericWordMul2Op' in genericIntMul2Op because a target may provide a faster primop for 'WordMul2Op': we'd better use it! - - - - - 686e7225 by Moritz Angermann at 2020-07-07T13:56:01-04:00 [linker/rtsSymbols] More linker symbols Mostly symbols needed for aarch64/armv7l and in combination with musl, where we have to rely on loading *all* objects/archives - __stack_chk_* only when not DYNAMIC - - - - - 3f60b94d by Moritz Angermann at 2020-07-07T13:56:01-04:00 better if guards. - - - - - 7abffced by Moritz Angermann at 2020-07-07T13:56:01-04:00 Fix (1) - - - - - cdfeb3f2 by Moritz Angermann at 2020-07-07T13:56:01-04:00 AArch32 symbols only on aarch32. - - - - - f496c955 by Adam Sandberg Ericsson at 2020-07-07T13:56:02-04:00 add -flink-rts flag to link the rts when linking a shared or static library #18072 By default we don't link the RTS when linking shared libraries because in the most usual mode a shared library is an intermediary product, for example a Haskell library, that will be linked into some executable in the end. So we wish to defer the RTS flavour to link to the final link. However sometimes the final product is the shared library, for example when writing a plugin for some other system, so we do wish the shared library to link the RTS. For consistency we also make -staticlib honor this flag and its inversion. -staticlib currently implies -flink-shared. - - - - - c59faf67 by Stefan Schulze Frielinghaus at 2020-07-07T13:56:04-04:00 hadrian: link check-ppr against debugging RTS if ghcDebugged - - - - - 0effc57d by Adam Sandberg Ericsson at 2020-07-07T13:56:05-04:00 rts linker: teach the linker about GLIBC's special handling of *stat, mknod and atexit functions #7072 - - - - - 96153433 by Adam Sandberg Ericsson at 2020-07-07T13:56:06-04:00 hadrian: make hadrian/ghci use the bootstrap compiler from configure #18190 - - - - - 4d24f886 by Adam Sandberg Ericsson at 2020-07-07T13:56:07-04:00 hadrian: ignore cabal configure verbosity related flags #18131 - - - - - 7332bbff by Ben Gamari at 2020-07-07T13:56:08-04:00 testsuite: Widen T12234 acceptance window to 2% Previously it wasn't uncommon to see +/-1% fluctuations in compiler allocations on this test. - - - - - 180b6313 by Gabor Greif at 2020-07-07T13:56:08-04:00 When running libtool, report it as such - - - - - d3bd6897 by Sylvain Henry at 2020-07-07T13:56:11-04:00 BigNum: rename BigNat types Before this patch BigNat names were confusing because we had: * GHC.Num.BigNat.BigNat: unlifted type used everywhere else * GHC.Num.BigNat.BigNatW: lifted type only used to share static constants * GHC.Natural.BigNat: lifted type only used for backward compatibility After this patch we have: * GHC.Num.BigNat.BigNat#: unlifted type * GHC.Num.BigNat.BigNat: lifted type (reexported from GHC.Natural) Thanks to @RyanGlScott for spotting this. - - - - - 929d26db by Sylvain Henry at 2020-07-07T13:56:12-04:00 Bignum: don't build ghc-bignum with stage0 Noticed by @Ericson2314 - - - - - d25b6851 by Sylvain Henry at 2020-07-07T13:56:12-04:00 Hadrian: ghc-gmp.h shouldn't be a compiler dependency - - - - - 0ddae2ba by Sylvain Henry at 2020-07-07T13:56:14-04:00 DynFlags: factor out pprUnitId from "Outputable UnitId" instance - - - - - 204f3f5d by Krzysztof Gogolewski at 2020-07-07T13:56:18-04:00 Remove unused function pprHsForAllExtra (#18423) The function `pprHsForAllExtra` was called only on `Nothing` since 2015 (1e041b7382b6aa). - - - - - 3033e0e4 by Adam Sandberg Ericsson at 2020-07-08T20:36:49-04:00 hadrian: add flag to skip rebuilding dependency information #17636 - - - - - b7de4b96 by Stefan Schulze Frielinghaus at 2020-07-09T09:49:22-04:00 Fix GHCi :print on big-endian platforms On big-endian platforms executing import GHC.Exts data Foo = Foo Float# deriving Show foo = Foo 42.0# foo :print foo results in an arithmetic overflow exception which is caused by function index where moveBytes equals word_size - (r + item_size_b) * 8 Here we have a mixture of units. Both, word_size and item_size_b have unit bytes whereas r has unit bits. On 64-bit platforms moveBytes equals then 8 - (0 + 4) * 8 which results in a negative and therefore invalid second parameter for a shiftL operation. In order to make things more clear the expression (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes is equivalent to (word `shiftR` moveBytes) .&. mask On big-endian platforms the shift must be a left shift instead of a right shift. For symmetry reasons not a mask is used but two shifts in order to zero out bits. Thus the fixed version equals case endian of BigEndian -> (word `shiftL` moveBits) `shiftR` zeroOutBits `shiftL` zeroOutBits LittleEndian -> (word `shiftR` moveBits) `shiftL` zeroOutBits `shiftR` zeroOutBits Fixes #16548 and #14455 - - - - - 3656dff8 by Sylvain Henry at 2020-07-09T09:50:01-04:00 LLVM: fix MO_S_Mul2 support (#18434) The value indicating if the carry is useful wasn't taken into account. - - - - - d9f09506 by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Define multiShotIO and use it in mkSplitUniqueSupply This patch is part of the ongoing eta-expansion saga; see #18238. It implements a neat trick (suggested by Sebastian Graf) that allows the programmer to disable the default one-shot behaviour of IO (the "state hack"). The trick is to use a new multiShotIO function; see Note [multiShotIO]. For now, multiShotIO is defined here in Unique.Supply; but it should ultimately be moved to the IO library. The change is necessary to get good code for GHC's unique supply; see Note [Optimising the unique supply]. However it makes no difference to GHC as-is. Rather, it makes a difference when a subsequent commit Improve eta-expansion using ArityType lands. - - - - - bce695cc by Simon Peyton Jones at 2020-07-10T10:33:44-04:00 Make arityType deal with join points As Note [Eta-expansion and join points] describes, this patch makes arityType deal correctly with join points. What was there before was not wrong, but yielded lower arities than it could. Fixes #18328 In base GHC this makes no difference to nofib. Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- n-body -0.1% -0.1% -1.2% -1.1% 0.0% -------------------------------------------------------------------------------- Min -0.1% -0.1% -55.0% -56.5% 0.0% Max -0.0% 0.0% +16.1% +13.4% 0.0% Geometric Mean -0.0% -0.0% -30.1% -31.0% -0.0% But it starts to make real difference when we land the change to the way mkDupableAlts handles StrictArg, in fixing #13253 and friends. I think this is because we then get more non-inlined join points. - - - - - 2b7c71cb by Simon Peyton Jones at 2020-07-11T12:17:02-04:00 Improve eta-expansion using ArityType As #18355 shows, we were failing to preserve one-shot info when eta-expanding. It's rather easy to fix, by using ArityType more, rather than just Arity. This patch is important to suport the one-shot monad trick; see #18202. But the extra tracking of one-shot-ness requires the patch Define multiShotIO and use it in mkSplitUniqueSupply If that patch is missing, ths patch makes things worse in GHC.Types.Uniq.Supply. With it, however, we see these improvements T3064 compiler bytes allocated -2.2% T3294 compiler bytes allocated -1.3% T12707 compiler bytes allocated -1.3% T13056 compiler bytes allocated -2.2% Metric Decrease: T3064 T3294 T12707 T13056 - - - - - de139cc4 by Artem Pelenitsyn at 2020-07-12T02:53:20-04:00 add reproducer for #15630 - - - - - c4de6a7a by Andreas Klebinger at 2020-07-12T02:53:55-04:00 Give Uniq[D]FM a phantom type for its key. This fixes #17667 and should help to avoid such issues going forward. The changes are mostly mechanical in nature. With two notable exceptions. * The register allocator. The register allocator references registers by distinct uniques. However they come from the types of VirtualReg, Reg or Unique in various places. As a result we sometimes cast the key type of the map and use functions which operate on the now typed map but take a raw Unique as actual key. The logic itself has not changed it just becomes obvious where we do so now. * <Type>Env Modules. As an example a ClassEnv is currently queried using the types `Class`, `Name`, and `TyCon`. This is safe since for a distinct class value all these expressions give the same unique. getUnique cls getUnique (classTyCon cls) getUnique (className cls) getUnique (tcName $ classTyCon cls) This is for the most part contained within the modules defining the interface. However it requires us to play dirty when we are given a `Name` to lookup in a `UniqFM Class a` map. But again the logic did not change and it's for the most part hidden behind the Env Module. Some of these cases could be avoided by refactoring but this is left for future work. We also bump the haddock submodule as it uses UniqFM. - - - - - c2cfdfde by Aaron Allen at 2020-07-13T09:00:33-04:00 Warn about empty Char enumerations (#18402) Currently the "Enumeration is empty" warning (-Wempty-enumerations) only fires for numeric literals. This patch adds support for `Char` literals so that enumerating an empty list of `Char`s will also trigger the warning. - - - - - c3ac87ec by Stefan Schulze Frielinghaus at 2020-07-13T09:01:10-04:00 hadrian: build check-ppr dynamic if GHC is build dynamic Fixes #18361 - - - - - 9ad072b4 by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Use dumpStyle when printing inlinings This just makes debug-printing consistent, and more informative. - - - - - e78c4efb by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Comments only - - - - - 7ccb760b by Simon Peyton Jones at 2020-07-13T14:52:49-04:00 Reduce result discount in conSize Ticket #18282 showed that the result discount given by conSize was massively too large. This patch reduces that discount to a constant 10, which just balances the cost of the constructor application itself. Note [Constructor size and result discount] elaborates, as does the ticket #18282. Reducing result discount reduces inlining, which affects perf. I found that I could increase the unfoldingUseThrehold from 80 to 90 in compensation; in combination with the result discount change I get these overall nofib numbers: Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- boyer -0.2% +5.4% -3.2% -3.4% 0.0% cichelli -0.1% +5.9% -11.2% -11.7% 0.0% compress2 -0.2% +9.6% -6.0% -6.8% 0.0% cryptarithm2 -0.1% -3.9% -6.0% -5.7% 0.0% gamteb -0.2% +2.6% -13.8% -14.4% 0.0% genfft -0.1% -1.6% -29.5% -29.9% 0.0% gg -0.0% -2.2% -17.2% -17.8% -20.0% life -0.1% -2.2% -62.3% -63.4% 0.0% mate +0.0% +1.4% -5.1% -5.1% -14.3% parser -0.2% -2.1% +7.4% +6.7% 0.0% primetest -0.2% -12.8% -14.3% -14.2% 0.0% puzzle -0.2% +2.1% -10.0% -10.4% 0.0% rsa -0.2% -11.7% -3.7% -3.8% 0.0% simple -0.2% +2.8% -36.7% -38.3% -2.2% wheel-sieve2 -0.1% -19.2% -48.8% -49.2% -42.9% -------------------------------------------------------------------------------- Min -0.4% -19.2% -62.3% -63.4% -42.9% Max +0.3% +9.6% +7.4% +11.0% +16.7% Geometric Mean -0.1% -0.3% -17.6% -18.0% -0.7% I'm ok with these numbers, remembering that this change removes an *exponential* increase in code size in some in-the-wild cases. I investigated compress2. The difference is entirely caused by this function no longer inlining WriteRoutines.$woutputCodes = \ (w :: [CodeEvent]) -> let result_s1Sr = case WriteRoutines.outputCodes_$s$woutput w 0# 0# 8# 9# of (# ww1, ww2 #) -> (ww1, ww2) in (# case result_s1Sr of (x, _) -> map @Int @Char WriteRoutines.outputCodes1 x , case result_s1Sr of { (_, y) -> y } #) It was right on the cusp before, driven by the excessive result discount. Too bad! Happily, the compiler/perf tests show a number of improvements: T12227 compiler bytes-alloc -6.6% T12545 compiler bytes-alloc -4.7% T13056 compiler bytes-alloc -3.3% T15263 runtime bytes-alloc -13.1% T17499 runtime bytes-alloc -14.3% T3294 compiler bytes-alloc -1.1% T5030 compiler bytes-alloc -11.7% T9872a compiler bytes-alloc -2.0% T9872b compiler bytes-alloc -1.2% T9872c compiler bytes-alloc -1.5% Metric Decrease: T12227 T12545 T13056 T15263 T17499 T3294 T5030 T9872a T9872b T9872c - - - - - 7f0b671e by Ben Gamari at 2020-07-13T14:52:49-04:00 testsuite: Widen acceptance threshold on T5837 This test is positively tiny and consequently the bytes allocated measurement will be relatively noisy. Consequently I have seen this fail spuriously quite often. - - - - - 118e1c3d by Alp Mestanogullari at 2020-07-14T21:30:52-04:00 compiler: re-engineer the treatment of rebindable if Executing on the plan described in #17582, this patch changes the way if expressions are handled in the compiler in the presence of rebindable syntax. We get rid of the SyntaxExpr field of HsIf and instead, when rebindable syntax is on, we rewrite the HsIf node to the appropriate sequence of applications of the local `ifThenElse` function. In order to be able to report good error messages, with expressions as they were written by the user (and not as desugared by the renamer), we make use of TTG extensions to extend GhcRn expression ASTs with an `HsExpansion` construct, which keeps track of a source (GhcPs) expression and the desugared (GhcRn) expression that it gives rise to. This way, we can typecheck the latter while reporting the former in error messages. In order to discard the error context lines that arise from typechecking the desugared expressions (because they talk about expressions that the user has not written), we carefully give a special treatment to the nodes fabricated by this new renaming-time transformation when typechecking them. See Note [Rebindable syntax and HsExpansion] for more details. The note also includes a recipe to apply the same treatment to other rebindable constructs. Tests 'rebindable11' and 'rebindable12' have been added to make sure we report identical error messages as before this patch under various circumstances. We also now disable rebindable syntax when processing untyped TH quotes, as per the discussion in #18102 and document the interaction of rebindable syntax and Template Haskell, both in Note [Template Haskell quotes and Rebindable Syntax] and in the user guide, adding a test to make sure that we do not regress in that regard. - - - - - 64c774b0 by Andreas Klebinger at 2020-07-14T21:31:27-04:00 Explain why keeping DynFlags in AnalEnv saves allocation. - - - - - 254245d0 by Ben Gamari at 2020-07-14T21:32:03-04:00 docs/users-guide: Update default -funfolding-use-threshold value This was changed in 3d2991f8 but I neglected to update the documentation. Fixes #18419. - - - - - 4c259f86 by Andreas Klebinger at 2020-07-14T21:32:41-04:00 Escape backslashes in json profiling reports properly. I also took the liberty to do away the fixed buffer size for escaping. Using a fixed size here can only lead to issues down the line. Fixes #18438. - - - - - 23797224 by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 .gitlab: re-enable integer-simple substitute (BIGNUM_BACKEND) Recently build system migrated from INTEGER_LIBRARY to BIGNUM_BACKEND. But gitlab CI was never updated. Let's enable BIGNUM_BACKEND=native. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - e0db878a by Sergei Trofimovich at 2020-07-14T21:33:19-04:00 ghc-bignum: bring in sync .hs-boot files with module declarations Before this change `BIGNUM_BACKEND=native` build was failing as: ``` libraries/ghc-bignum/src/GHC/Num/BigNat/Native.hs:708:16: error: * Variable not in scope: naturalFromBigNat# :: WordArray# -> t * Perhaps you meant one of these: `naturalFromBigNat' (imported from GHC.Num.Natural), `naturalToBigNat' (imported from GHC.Num.Natural) | 708 | m' = naturalFromBigNat# m | ``` This happens because `.hs-boot` files are slightly out of date. This change brings in data and function types in sync. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - c9f65c36 by Stefan Schulze Frielinghaus at 2020-07-14T21:33:57-04:00 rts/Disassembler.c: Use FMT_HexWord for printing values in hex format - - - - - 58ae62eb by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 macOS: Load frameworks without stating them first. macOS Big Sur makes the following change to how frameworks are shipped with the OS: > New in macOS Big Sur 11 beta, the system ships with a built-in > dynamic linker cache of all system-provided libraries. As part of > this change, copies of dynamic libraries are no longer present on > the filesystem. Code that attempts to check for dynamic library > presence by looking for a file at a path or enumerating a directory > will fail. Instead, check for library presence by attempting to > dlopen() the path, which will correctly check for the library in the > cache. (62986286) https://developer.apple.com/documentation/macos-release-notes/macos-big-sur-11-beta-release-notes/ Therefore, the previous method of checking whether a library exists before attempting to load it makes GHC.Runtime.Linker.loadFramework fail to find frameworks installed at /System/Library/Frameworks. GHC.Runtime.Linker.loadFramework now opportunistically loads the framework libraries without checking for their existence first, failing only if all attempts to load a given framework from any of the various possible locations fail. - - - - - cdc4a6b0 by Matthias Andreas Benkard at 2020-07-14T21:34:35-04:00 loadFramework: Output the errors collected in all loading attempts. With the recent change away from first finding and then loading a framework, loadFramework had no way of communicating the real reason why loadDLL failed if it was any reason other than the framework missing from the file system. It now collects all loading attempt errors into a list and concatenates them into a string to return to the caller. - - - - - 51dbfa52 by Ben Gamari at 2020-07-15T04:05:34-04:00 StgToCmm: Use CmmRegOff smart constructor Previously we would generate expressions of the form `CmmRegOff BaseReg 0`. This should do no harm (and really should be handled by the NCG anyways) but it's better to just generate a plain `CmmReg`. - - - - - ae11bdfd by Ben Gamari at 2020-07-15T04:06:08-04:00 testsuite: Add regression test for #17744 Test due to @monoidal. - - - - - 0e3c277a by Ben Gamari at 2020-07-15T16:41:01-04:00 Bump Cabal submodule Updates a variety of tests as Cabal is now more strict about Cabal file form. - - - - - ceed994a by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Drop Windows Vista support, require Windows 7 - - - - - 00a23bfd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Update Windows FileSystem wrapper utilities. - - - - - 459e1c5f by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Use SlimReaderLocks and ConditonalVariables provided by the OS instead of emulated ones - - - - - 763088fc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Small linker comment and ifdef cleanups - - - - - 1a228ff9 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Flush event logs eagerly. - - - - - e9e04dda by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Refactor Buffer structures to be able to track async operations - - - - - 356dc3fe by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Implement new Console API - - - - - 90e69f77 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add IOPort synchronization primitive - - - - - 71245fcc by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add new io-manager cmdline options - - - - - d548a3b3 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Init Windows console Codepage to UTF-8. - - - - - 58ef6366 by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add unsafeSplat to GHC.Event.Array - - - - - d660725e by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Add size and iterate to GHC.Event.IntTable. - - - - - 050da6dd by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Switch Testsuite to test winio by default - - - - - 4bf542bf by Tamar Christina at 2020-07-15T16:41:01-04:00 winio: Multiple refactorings and support changes. - - - - - 4489af6b by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core threaded I/O manager - - - - - 64d8f2fe by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: core non-threaded I/O manager - - - - - 8da15a09 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix a scheduler bug with the threaded-runtime. - - - - - 84ea3d14 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Relaxing some constraints in io-manager. - - - - - ccf0d107 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Fix issues with non-threaded I/O manager after split. - - - - - b492fe6e by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Remove some barf statements that are a bit strict. - - - - - 01423fd2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Expand comments describing non-threaded loop - - - - - 4b69004f by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: fix FileSize unstat-able handles - - - - - 9b384270 by Tamar Christina at 2020-07-15T16:41:02-04:00 winio: Implement new tempfile routines for winio - - - - - f1e0be82 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix input truncation when reading from handle. This was caused by not upholding the read buffer invariant that bufR == bufL == 0 for empty read buffers. - - - - - e176b625 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix output truncation for writes larger than buffer size - - - - - a831ce0e by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Rewrite bufWrite. I think it's far easier to follow the code now. It's also correct now as I had still missed a spot where we didn't update the offset. - - - - - 6aefdf62 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix offset set by bufReadEmpty. bufReadEmpty returns the bytes read *including* content that was already buffered, But for calculating the offset we only care about the number of bytes read into the new buffer. - - - - - 750ebaee by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Clean up code surrounding IOPort primitives. According to phyx these should only be read and written once per object. Not neccesarily in that order. To strengthen that guarantee the primitives will now throw an exception if we violate this invariant. As a consequence we can eliminate some code from their primops. In particular code dealing with multiple queued readers/writers now simply checks the invariant and throws an exception if it was violated. That is in contrast to mvars which will do things like wake up all readers, queue multi writers etc. - - - - - ffd31db9 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix multi threaded threadDelay and a few other small changes. Multithreaded threadDelay suffered from a race condition based on the ioManagerStatus. Since the status isn't needed for WIO I removed it completely. This resulted in a light refactoring, as consequence we will always wake up the IO manager using interruptSystemManager, which uses `postQueuedCompletionStatus` internally. I also added a few comments which hopefully makes the code easier to dive into for the next person diving in. - - - - - 6ec26df2 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 wionio: Make IO subsystem check a no-op on non-windows platforms. - - - - - 29bcd936 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Set handle offset when opening files in Append mode. Otherwise we would truncate the file. - - - - - 55c29700 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Remove debug event log trace - - - - - 9acb9f40 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix sqrt and openFile009 test cases - - - - - 57017cb7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Allow hp2ps to build with -DDEBUG - - - - - b8cd9995 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update output of T9681 since we now actually run it. - - - - - 10af5b14 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: A few more improvements to the IOPort primitives. - - - - - 39afc4a7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix expected tempfiles output. Tempfiles now works properly on windows, as such we can delete the win32 specific output. - - - - - 99db46e0 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Assign thread labels to IOManager threads. - - - - - be6af732 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Properly check for the tso of an incall to be zero. - - - - - e2c6dac7 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark FD instances as unsupported under WINIO. - - - - - fd02ceed by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Fix threadDelay maxBound invocations. Instead of letting the ns timer overflow now clamp it at (maxBound :: Word64) ns. That still gives a few hundred years. - - - - - bc79f9f1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comments/cleanup an import in base - - - - - 1d197f4b by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Mark outstanding_service_requests volatile. As far as I know C(99) gives no guarantees for code like bool condition; ... while(condition) sleep(); that condition will be updated if it's changed by another thread. So we are explicit here and mark it as volatile, this will force a reload from memory on each iteration. - - - - - dc438186 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Make last_event a local variable - - - - - 2fc957c5 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add comment about thread safety of processCompletion. - - - - - 4c026b6c by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: nonthreaded: Create io processing threads in main thread. We now set a flag in the IO thread. The scheduler when looking for work will check the flag and create/queue threads accordingly. We used to create these in the IO thread. This improved performance but caused frequent segfaults. Thread creation/allocation is only safe to do if nothing currently accesses the storeagemanager. However without locks in the non-threaded runtime this can't be guaranteed. This shouldn't change performance all too much. In the past we had: * IO: Create/Queue thread. * Scheduler: Runs a few times. Eventually picks up IO processing thread. Now it's: * IO: Set flag to queue thread. * Scheduler: Pick up flag, if set create/queue thread. Eventually picks up IO processing thread. - - - - - f47c7208 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Add an exported isHeapAlloced function to the RTS - - - - - cc5d7bb1 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Queue IO processing threads at the front of the queue. This will unblock the IO thread sooner hopefully leading to higher throughput in some situations. - - - - - e7630115 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: ThreadDelay001: Use higher resolution timer. - - - - - 451b5f96 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Update T9681 output, disable T4808 on windows. T4808 tests functionality of the FD interface which won't be supported under WINIO. T9681 just has it's expected output tweaked. - - - - - dd06f930 by Andreas Klebinger at 2020-07-15T16:41:02-04:00 winio: Wake io manager once per registerTimeout. Which is implicitly done in editTimeouts, so need to wake it up twice. - - - - - e87d0bf9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update placeholder comment with actual function name. - - - - - fc9025db by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Always lock win32 event queue - - - - - c24c9a1f by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Display thread labels when tracing scheduler events. - - - - - 06542b03 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Refactor non-threaded runner thread and scheduler interface. Only use a single communication point (registerAlertableWait) to inform the C side aobut both timeouts to use as well as outstanding requests. Also queue a haskell processing thread after each return from alertable waits. This way there is no risk of us missing a timer event. - - - - - 256299b1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove outstanding_requests from runner. We used a variable to keep track of situations where we got entries from the IO port, but all of them had already been canceled. While we can avoid some work that way this case seems quite rare. So we give up on tracking this and instead always assume at least one of the returned entries is valid. If that's not the case no harm is done, we just perform some additional work. But it makes the runner easier to reason about. In particular we don't need to care if another thread modifies oustanding_requests after we return from waiting on the IO Port. - - - - - 3ebd8ad9 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Various fixes related to rebase and testdriver - - - - - 6be6bcba by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: Fix rebase artifacts - - - - - 2c649dc3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename unsafeSplat to unsafeCopyFromBuffer - - - - - a18b73f3 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove unused size/iterate operations from IntTable - - - - - 16bab48e by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Detect running IO Backend via peeking at RtsConfig - - - - - 8b8405a0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update temp path so GCC etc can handle it. Also fix PIPE support, clean up error casting, fix memory leaks - - - - - 2092bc54 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Minor comments/renamings - - - - - a5b5b6c0 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Checking if an error code indicates completion is now a function. - - - - - 362176fd by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Small refactor in withOverlappedEx - - - - - 32e20597 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: A few comments and commented out dbxIO - - - - - a4bfc1d9 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't drop buffer offset in byteView/cwcharView - - - - - b3ad2a54 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: revert BHandle changes. - - - - - 3dcd87e2 by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Fix imports - - - - - 5a371890 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: update ghc-cabal to handle new Cabal submodule bump - - - - - d07ebe0d by Ben Gamari at 2020-07-15T16:41:03-04:00 winio: Only compile sources on Windows - - - - - dcb42393 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Actually return Nothing on EOF for non-blocking read - - - - - 895a3beb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate logic in encodeMultiByte[Raw]IO. - - - - - e06e6734 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Deduplicate openFile logic - - - - - b59430c0 by Tamar Christina at 2020-07-15T16:41:03-04:00 winio: fix -werror issue in encoding file - - - - - f8d39a51 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Don't mention windows specific functions when building on Linux. - - - - - 6a533d2a by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add a note about file locking in the RTS. - - - - - cf37ce34 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Add version to @since annotation - - - - - 0fafa2eb by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename GHC.Conc.IOCP -> GHC.Conc.WinIO - - - - - 1854fc23 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Expand GHC.Conc.POSIX description It now explains users may not use these functions when using the old IO manager. - - - - - fcc7ba41 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Fix potential spaceleak in __createUUIDTempFileErrNo - - - - - 6b3fd9fa by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant -Wno-missing-signatures pragmas - - - - - 916fc861 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Make it explicit that we only create one IO manager - - - - - f260a721 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Note why we don't use blocking waits. - - - - - aa0a4bbf by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove commented out pragma - - - - - d679b544 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Remove redundant buffer write in Handle/Text.hs:bufReadEmpty - - - - - d3f94368 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Rename SmartHandles to StdHandles - - - - - bd6b8ec1 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: add comment stating failure behaviour for getUniqueFileInfo. - - - - - 12846b85 by Andreas Klebinger at 2020-07-15T16:41:03-04:00 winio: Update IOPort haddocks. - - - - - 9f39fb14 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Add a note cross reference - - - - - 62dd5a73 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Name Haskell/OS I/O Manager explicitly in Note - - - - - fa807828 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Expand BlockedOnIOCompletion description. - - - - - f0880a1d by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove historical todos - - - - - 8e58e714 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Update note, remove debugging pragma. - - - - - aa4d84d5 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: flushCharReadBuffer shouldn't need to adjust offsets. - - - - - e580893a by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Remove obsolete comment about cond. variables - - - - - d54e9d79 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix initial linux validate build - - - - - 3cd4de46 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix ThreadDelay001 CPP - - - - - c88b1b9f by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix openFile009 merge conflict leftover - - - - - 849e8889 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept T9681 output. GHC now reports String instead of [Char]. - - - - - e7701818 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix cabal006 after upgrading cabal submodule Demand cabal 2.0 syntax instead of >= 1.20 as required by newer cabal versions. - - - - - a44f0373 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Fix stderr output for ghci/linking/dyn tests. We used to filter rtsopts, i opted to instead just accept the warning of it having no effect. This works both for -rtsopts, as well as -with-rtsopts which winio adds. - - - - - 515d9896 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T15261b stdout for --io-manager flag. - - - - - 949aaacc by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Adjust T5435_dyn_asm stderr The warning about rtsopts having no consequences is expected. So accept new stderr. - - - - - 7d424e1e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Also accept T7037 stderr - - - - - 1f009768 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal04 by filtering rts args - - - - - 981a9f2e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix cabal01 by accepting expected stderr - - - - - b7b0464e by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix safePkg01 by accepting expected stderr - - - - - 32734b29 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix T5435_dyn_gcc by accepting expected stderr - - - - - acc5cebf by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: fix tempfiles test on linux - - - - - c577b789 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for T3807 - - - - - c108c527 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload - - - - - 2b0b9a08 by Andreas Klebinger at 2020-07-15T16:41:04-04:00 winio: Accept accepted stderr for linker_unload_multiple_objs - - - - - 67afb03c by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify wording on conditional variables. - - - - - 3bd41572 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: clarify comment on cooked mode. - - - - - ded58a03 by Tamar Christina at 2020-07-15T16:41:04-04:00 winio: update lockfile signature and remove mistaken symbol in rts. - - - - - 2143c492 by Ben Gamari at 2020-07-15T16:41:04-04:00 testsuite: Add winio and winio_threaded ways Reverts many of the testsuite changes - - - - - c0979cc5 by Ben Gamari at 2020-07-16T10:56:54-04:00 Merge remote-tracking branch 'origin/wip/winio' - - - - - 750a1595 by Ben Gamari at 2020-07-18T07:26:41-04:00 rts: Add --copying-gc flag to reverse effect of --nonmoving-gc Fixes #18281. - - - - - 6ba6a881 by Hécate at 2020-07-18T07:26:42-04:00 Implement `fullCompilerVersion` Follow-up of https://gitlab.haskell.org/ghc/ghc/-/issues/18403 This MR adds `fullCompilerVersion`, a function that shares the same backend as the `--numeric-version` GHC flag, exposing a full, three-digit version datatype. - - - - - e6cf27df by Hécate at 2020-07-18T07:26:43-04:00 Add a Lint hadrian rule and an .hlint.yaml file in base/ - - - - - bcb177dd by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Allow multiple case branches to have a higher rank type As #18412 points out, it should be OK for multiple case alternatives to have a higher rank type, provided they are all the same. This patch implements that change. It sweeps away GHC.Tc.Gen.Match.tauifyMultipleBranches, and friends, replacing it with an enhanced version of fillInferResult. The basic change to fillInferResult is to permit the case in which another case alternative has already filled in the result; and in that case simply unify. It's very simple actually. See the new Note [fillInferResult] in TcMType Other refactoring: - Move all the InferResult code to one place, in GHC.Tc.Utils.TcMType (previously some of it was in Unify) - Move tcInstType and friends from TcMType to Instantiate, where it more properly belongs. (TCMType was getting very long.) - - - - - e5525a51 by Simon Peyton Jones at 2020-07-18T07:26:43-04:00 Improve typechecking of NPlusK patterns This patch (due to Richard Eisenberg) improves documentation of the wrapper returned by tcSubMult (see Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify). And, more substantially, it cleans up the multiplicity handling in the typechecking of NPlusKPat - - - - - 12f90352 by Krzysztof Gogolewski at 2020-07-18T07:26:45-04:00 Remove {-# CORE #-} pragma (part of #18048) This pragma has no effect since 2011. It was introduced for External Core, which no longer exists. Updates haddock submodule. - - - - - e504c913 by Simon Peyton Jones at 2020-07-18T07:26:45-04:00 Refactor the simplification of join binders This MR (for #18449) refactors the Simplifier's treatment of join-point binders. Specifically, it puts together, into GHC.Core.Opt.Simplify.Env.adjustJoinPointType two currently-separate ways in which we adjust the type of a join point. As the comment says: -- (adjustJoinPointType mult new_res_ty join_id) does two things: -- -- 1. Set the return type of the join_id to new_res_ty -- See Note [Return type for join points] -- -- 2. Adjust the multiplicity of arrows in join_id's type, as -- directed by 'mult'. See Note [Scaling join point arguments] I think this actually fixes a latent bug, by ensuring that the seIdSubst and seInScope have the right multiplicity on the type of join points. I did some tidying up while I was at it. No more setJoinResTy, or modifyJoinResTy: instead it's done locally in Simplify.Env.adjustJoinPointType - - - - - 49b265f0 by Chaitanya Koparkar at 2020-07-18T07:26:46-04:00 Fix minor typos in a Core.hs note - - - - - 8d59aed6 by Stefan Schulze Frielinghaus at 2020-07-18T07:26:47-04:00 GHCi: Fix isLittleEndian - - - - - c26e81d1 by Ben Gamari at 2020-07-18T07:26:47-04:00 testsuite: Mark ghci tests as fragile under unreg compiler In particular I have seen T16012 fail repeatedly under the unregisterised compiler. - - - - - 868e4523 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "AArch32 symbols only on aarch32." This reverts commit cdfeb3f24f76e8fd30452016676e56fbc827789a. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - c915ba84 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "Fix (1)" This reverts commit 7abffced01f5680efafe44f6be2733eab321b039. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 777c452a by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "better if guards." This reverts commit 3f60b94de1f460ca3f689152860b108a19ce193e. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 0dd40552 by Moritz Angermann at 2020-07-20T04:30:38-04:00 Revert "[linker/rtsSymbols] More linker symbols" This reverts commit 686e72253aed3880268dd6858eadd8c320f09e97. Signed-off-by: Moritz Angermann <moritz.angermann at gmail.com> - - - - - 30caeee7 by Sylvain Henry at 2020-07-21T06:39:33-04:00 DynFlags: remove use of sdocWithDynFlags from GHC.Stg.* (#17957) * add StgPprOpts datatype * remove Outputable instances for types that need `StgPprOpts` to be pretty-printed and explicitly call type specific ppr functions * add default `panicStgPprOpts` for panic messages (when it's not convenient to thread StgPprOpts or DynFlags down to the ppr function call) - - - - - 863c544c by Mark at 2020-07-21T06:39:34-04:00 Fix a typo in existential_quantification.rst - - - - - 05910be1 by Krzysztof Gogolewski at 2020-07-21T14:47:07-04:00 Add release notes entry for #17816 [skip ci] - - - - - a6257192 by Matthew Pickering at 2020-07-21T14:47:19-04:00 Use a newtype `Code` for the return type of typed quotations (Proposal #195) There are three problems with the current API: 1. It is hard to properly write instances for ``Quote m => m (TExp a)`` as the type is the composition of two type constructors. Doing so in your program involves making your own newtype and doing a lot of wrapping/unwrapping. For example, if I want to create a language which I can either run immediately or generate code from I could write the following with the new API. :: class Lang r where _int :: Int -> r Int _if :: r Bool -> r a -> r a -> r a instance Lang Identity where _int = Identity _if (Identity b) (Identity t) (Identity f) = Identity (if b then t else f) instance Quote m => Lang (Code m) where _int = liftTyped _if cb ct cf = [|| if $$cb then $$ct else $$cf ||] 2. When doing code generation it is common to want to store code fragments in a map. When doing typed code generation, these code fragments contain a type index so it is desirable to store them in one of the parameterised map data types such as ``DMap`` from ``dependent-map`` or ``MapF`` from ``parameterized-utils``. :: compiler :: Env -> AST a -> Code Q a data AST a where ... data Ident a = ... type Env = MapF Ident (Code Q) newtype Code m a = Code (m (TExp a)) In this example, the ``MapF`` maps an ``Ident String`` directly to a ``Code Q String``. Using one of these map types currently requires creating your own newtype and constantly wrapping every quotation and unwrapping it when using a splice. Achievable, but it creates even more syntactic noise than normal metaprogramming. 3. ``m (TExp a)`` is ugly to read and write, understanding ``Code m a`` is easier. This is a weak reason but one everyone can surely agree with. Updates text submodule. - - - - - 58235d46 by Ben Gamari at 2020-07-21T14:47:28-04:00 users-guide: Fix :rts-flag:`--copying-gc` documentation It was missing a newline. - - - - - 19e80b9a by Vladislav Zavialov at 2020-07-21T14:50:01-04:00 Accumulate Haddock comments in P (#17544, #17561, #8944) Haddock comments are, first and foremost, comments. It's very annoying to incorporate them into the grammar. We can take advantage of an important property: adding a Haddock comment does not change the parse tree in any way other than wrapping some nodes in HsDocTy and the like (and if it does, that's a bug). This patch implements the following: * Accumulate Haddock comments with their locations in the P monad. This is handled in the lexer. * After parsing, do a pass over the AST to associate Haddock comments with AST nodes using location info. * Report the leftover comments to the user as a warning (-Winvalid-haddock). - - - - - 4c719460 by David Binder at 2020-07-22T20:17:35-04:00 Fix dead link to haskell prime discussion - - - - - f2f817e4 by BinderDavid at 2020-07-22T20:17:35-04:00 Replace broken links to old haskell-prime site by working links to gitlab instance. [skip ci] - - - - - 0bf8980e by Daniel Gröber at 2020-07-22T20:18:11-04:00 Remove length field from FastString - - - - - 1010c33b by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use ShortByteString for FastString There are multiple reasons we want this: - Fewer allocations: ByteString has 3 fields, ShortByteString just has one. - ByteString memory is pinned: - This can cause fragmentation issues (see for example #13110) but also - makes using FastStrings in compact regions impossible. Metric Decrease: T5837 T12150 T12234 T12425 - - - - - 8336ba78 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Pass specialised utf8DecodeChar# to utf8DecodeLazy# for performance Currently we're passing a indexWord8OffAddr# type function to utf8DecodeLazy# which then passes it on to utf8DecodeChar#. By passing one of utf8DecodeCharAddr# or utf8DecodeCharByteArray# instead we benefit from the inlining and specialization already done for those. - - - - - 7484a9a4 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Add comment about tricky ForeignPtr lifetime - - - - - 5536ed28 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Use IO constructor instead of `stToIO . ST` - - - - - 5b8902e3 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Remove redundant use of withForeignPtr - - - - - 5976a161 by Daniel Gröber at 2020-07-22T20:18:11-04:00 Encoding: Reformat utf8EncodeShortByteString to be more consistent - - - - - 9ddf1614 by Daniel Gröber at 2020-07-22T20:18:11-04:00 FastString: Reintroduce character count cache Metric Increase: ManyConstructors Metric Decrease: T4029 - - - - - e9491668 by Ben Gamari at 2020-07-22T20:18:46-04:00 get-win32-tarballs: Fix detection of missing tarballs This fixes the error message given by configure when the user attempts to configure without first download the win32 tarballs. - - - - - 9f3ff8fd by Andreas Klebinger at 2020-07-22T20:19:22-04:00 Enable BangPatterns, ScopedTypeVariables for ghc and hadrian by default. This is only for their respective codebases. - - - - - 0f17b930 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused "ncg" flag This flag has been removed in 066b369de2c6f7da03c88206288dca29ab061b31 in 2011. - - - - - bab4ec8f by Sylvain Henry at 2020-07-22T20:19:59-04:00 Don't panic if the NCG isn't built (it is always built) - - - - - 8ea33edb by Sylvain Henry at 2020-07-22T20:19:59-04:00 Remove unused sGhcWithNativeCodeGen - - - - - e079bb72 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Correctly test active backend Previously we used a platform settings to detect if the native code generator was used. This was wrong. We need to use the `DynFlags.hscTarget` field instead. - - - - - 735f9d6b by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace ghcWithNativeCodeGen with a proper Backend datatype * Represent backends with a `Backend` datatype in GHC.Driver.Backend * Don't detect the default backend to use for the target platform at compile time in Hadrian/make but at runtime. It makes "Settings" simpler and it is a step toward making GHC multi-target. * The latter change also fixes hadrian which has not been updated to take into account that the NCG now supports AIX and PPC64 (cf df26b95559fd467abc0a3a4151127c95cb5011b9 and d3c1dda60d0ec07fc7f593bfd83ec9457dfa7984) * Also we don't treat iOS specifically anymore (cf cb4878ffd18a3c70f98bdbb413cd3c4d1f054e1f) - - - - - f7cc4313 by Sylvain Henry at 2020-07-22T20:19:59-04:00 Replace HscTarget with Backend They both have the same role and Backend name is more explicit. Metric Decrease: T3064 Update Haddock submodule - - - - - 15ce1804 by Andreas Klebinger at 2020-07-22T20:20:34-04:00 Deprecate -fdmd-tx-dict-sel. It's behaviour is now unconditionally enabled as it's slightly beneficial. There are almost no benchmarks which benefit from disabling it, so it's not worth the keep this configurable. This fixes #18429. - - - - - ff1b7710 by Sylvain Henry at 2020-07-22T20:21:11-04:00 Add test for #18064 It has been fixed by 0effc57d48ace6b719a9f4cbeac67c95ad55010b - - - - - cfa89149 by Krzysztof Gogolewski at 2020-07-22T20:21:48-04:00 Define type Void# = (# #) (#18441) There's one backwards compatibility issue: GHC.Prim no longer exports Void#, we now manually re-export it from GHC.Exts. - - - - - 02f40b0d by Sebastian Graf at 2020-07-22T20:22:23-04:00 Add regression test for #18478 !3392 backported !2993 to GHC 8.10.2 which most probably is responsible for fixing #18478, which triggered a pattern match checker performance regression in GHC 8.10.1 as first observed in #17977. - - - - - 7f44df1e by Sylvain Henry at 2020-07-22T20:23:00-04:00 Minor refactoring of Unit display * for consistency, try to always use UnitPprInfo to display units to users * remove some uses of `unitPackageIdString` as it doesn't show the component name and it uses String - - - - - dff1cb3d by Moritz Angermann at 2020-07-23T07:55:29-04:00 [linker] Fix out of range relocations. mmap may return address all over the place. mmap_next will ensure we get the next free page after the requested address. This is especially important for linking on aarch64, where the memory model with PIC admits relocations in the +-4GB range, and as such we can't work with arbitrary object locations in memory. Of note: we map the rts into process space, so any mapped objects must not be ouside of the 4GB from the processes address space. - - - - - cdd0ff16 by Tamar Christina at 2020-07-24T18:12:23-04:00 winio: restore console cp on exit - - - - - c1f4f81d by Tamar Christina at 2020-07-24T18:13:00-04:00 winio: change memory allocation strategy and fix double free errors. - - - - - ba205046 by Simon Peyton Jones at 2020-07-24T18:13:35-04:00 Care with occCheckExpand in kind of occurrences Issue #18451 showed that we could get an infinite type, through over-use of occCheckExpand in the kind of an /occurrence/ of a type variable. See Note [Occurrence checking: look inside kinds] in GHC.Core.Type This patch fixes the problem by making occCheckExpand less eager to expand synonyms in kinds. It also improves pretty printing of kinds, by *not* suppressing the kind on a tyvar-binder like (a :: Const Type b) where type Const p q = p. Even though the kind of 'a' is Type, we don't want to suppress the kind ascription. Example: the error message for polykinds/T18451{a,b}. See GHC.Core.TyCo.Ppr Note [Suppressing * kinds]. - - - - - 02133353 by Zubin Duggal at 2020-07-25T00:44:30-04:00 Simplify XRec definition Change `Located X` usage to `XRec pass X` This increases the scope of the LPat experiment to almost all of GHC. Introduce UnXRec and MapXRec classes Fixes #17587 and #18408 Updates haddock submodule Co-authored-by: Philipp Krüger <philipp.krueger1 at gmail.com> - - - - - e443846b by Sylvain Henry at 2020-07-25T00:45:07-04:00 DynFlags: store printer in TraceBinIfaceReading We don't need to pass the whole DynFlags, just pass the logging function, if any. - - - - - 15b2b44f by Sylvain Henry at 2020-07-25T00:45:08-04:00 Rename GHC.Driver.Ways into GHC.Platform.Ways - - - - - 342a01af by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add GHC.Platform.Profile - - - - - 6333d739 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Put PlatformConstants into Platform - - - - - 9dfeca6c by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove platform constant wrappers Platform constant wrappers took a DynFlags parameter, hence implicitly used the target platform constants. We removed them to allow support for several platforms at once (#14335) and to avoid having to pass the full DynFlags to every function (#17957). Metric Decrease: T4801 - - - - - 73145d57 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Remove dead code in utils/derivConstants - - - - - 7721b923 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Move GHC.Platform into the compiler Previously it was in ghc-boot so that ghc-pkg could use it. However it wasn't necessary because ghc-pkg only uses a subset of it: reading target arch and OS from the settings file. This is now done via GHC.Platform.ArchOS (was called PlatformMini before). - - - - - 459afeb5 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Fix build systems - - - - - 9e2930c3 by Sylvain Henry at 2020-07-25T00:45:08-04:00 Bump CountParserDeps - - - - - 6e2db34b by Sylvain Henry at 2020-07-25T00:45:08-04:00 Add accessors to ArchOS - - - - - fc0f6fbc by Stefan Schulze Frielinghaus at 2020-07-25T00:45:45-04:00 Require SMP support in order to build a threaded stage1 Fixes 18266 - - - - - a7c4439a by Matthias Andreas Benkard at 2020-07-26T13:23:24-04:00 Document loadFramework changes. (#18446) Adds commentary on the rationale for the changes made in merge request !3689. - - - - - da7269a4 by Ben Gamari at 2020-07-26T13:23:59-04:00 rts/win32: Exit with EXIT_HEAPOVERFLOW if memory commit fails Since switching to the two-step allocator, the `outofmem` test fails via `osCommitMemory` failing to commit. However, this was previously exiting with `EXIT_FAILURE`, rather than `EXIT_HEAPOVERFLOW`. I think the latter is a more reasonable exit code for this case and matches the behavior on POSIX platforms. - - - - - f153a1d0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Update win32 output for parseTree - - - - - e91672f0 by Ben Gamari at 2020-07-26T13:23:59-04:00 testsuite: Normalise WinIO error message differences Previously the old Windows IO manager threw different errors than WinIO. We now canonicalise these to the WinIO errors. - - - - - 9cbfe086 by Ben Gamari at 2020-07-26T13:23:59-04:00 gitlab-ci: Kill ssh-agent after pushing test metrics Otherwise the Windows builds hang forever waiting for the process to terminate. - - - - - 8236925f by Tamar Christina at 2020-07-26T13:24:35-04:00 winio: remove dead argument to stg_newIOPortzh - - - - - ce0a1d67 by Tamar Christina at 2020-07-26T13:25:11-04:00 winio: fix detection of tty terminals - - - - - 52685cf7 by Tamar Christina at 2020-07-26T13:25:48-04:00 winio: update codeowners - - - - - aee45d9e by Vladislav Zavialov at 2020-07-27T07:06:56-04:00 Improve NegativeLiterals (#18022, GHC Proposal #344) Before this patch, NegativeLiterals used to parse x-1 as x (-1). This may not be what the user expects, and now it is fixed: x-1 is parsed as (-) x 1. We achieve this by the following requirement: * When lexing a negative literal, it must not be preceded by a 'closing token'. This also applies to unboxed literals, e.g. -1#. See GHC Proposal #229 for the definition of a closing token. A nice consequence of this change is that -XNegativeLiterals becomes a subset of -XLexicalNegation. In other words, enabling both of those extensions has the same effect as enabling -XLexicalNegation alone. - - - - - 667ab69e by leiftw at 2020-07-27T07:07:32-04:00 fix typo referring to non-existent `-ohidir` flag, should be `-hidir` I think - - - - - 6ff89c17 by Vladislav Zavialov at 2020-07-27T07:08:07-04:00 Refactor the parser a little * Create a dedicated production for type operators * Create a dedicated type for the UNPACK pragma * Remove an outdated part of Note [Parsing data constructors is hard] - - - - - aa054d32 by Ben Gamari at 2020-07-27T20:09:07-04:00 Drop 32-bit Windows support As noted in #18487, we have reached the end of this road. - - - - - 6da73bbf by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Add minimal test for #12492 - - - - - 47680cb7 by Michalis Pardalos at 2020-07-27T20:09:44-04:00 Use allocate, not ALLOC_PRIM_P for unpackClosure# ALLOC_PRIM_P fails for large closures, by directly using allocate we can handle closures which are larger than the block size. Fixes #12492 - - - - - 3d345c96 by Simon Peyton Jones at 2020-07-27T20:10:19-04:00 Eta-expand the Simplifier monad This patch eta-expands the Simplifier's monad, using the method explained in GHC.Core.Unify Note [The one-shot state monad trick]. It's part of the exta-expansion programme in #18202. It's a tiny patch, but is worth a 1-2% reduction in bytes-allocated by the compiler. Here's the list, based on the compiler-performance tests in perf/compiler: Reduction in bytes allocated T10858(normal) -0.7% T12425(optasm) -1.3% T13056(optasm) -1.8% T14683(normal) -1.1% T15164(normal) -1.3% T15630(normal) -1.4% T17516(normal) -2.3% T18282(normal) -1.6% T18304(normal) -0.8% T1969(normal) -0.6% T4801(normal) -0.8% T5321FD(normal) -0.7% T5321Fun(normal) -0.5% T5642(normal) -0.9% T6048(optasm) -1.1% T9020(optasm) -2.7% T9233(normal) -0.7% T9675(optasm) -0.5% T9961(normal) -2.9% WWRec(normal) -1.2% Metric Decrease: T12425 T9020 T9961 - - - - - 57aca6bb by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Ensure that Hadrian jobs don't download artifacts Previously the Hadrian jobs had the default dependencies, meaning that they would download artifacts from all jobs of earlier stages. This is unneccessary. - - - - - 0a815cea by Ben Gamari at 2020-07-27T20:10:54-04:00 gitlab-ci: Bump bootstrap compiler to 8.8.4 Hopefully this will make the Windows jobs a bit more reliable. - - - - - 0bd60059 by Simon Peyton Jones at 2020-07-28T02:01:49-04:00 This patch addresses the exponential blow-up in the simplifier. Specifically: #13253 exponential inlining #10421 ditto #18140 strict constructors #18282 another nested-function call case This patch makes one really significant changes: change the way that mkDupableCont handles StrictArg. The details are explained in GHC.Core.Opt.Simplify Note [Duplicating StrictArg]. Specific changes * In mkDupableCont, when making auxiliary bindings for the other arguments of a call, add extra plumbing so that we don't forget the demand on them. Otherwise we haev to wait for another round of strictness analysis. But actually all the info is to hand. This change affects: - Make the strictness list in ArgInfo be [Demand] instead of [Bool], and rename it to ai_dmds. - Add as_dmd to ValArg - Simplify.makeTrivial takes a Demand - mkDupableContWithDmds takes a [Demand] There are a number of other small changes 1. For Ids that are used at most once in each branch of a case, make the occurrence analyser record the total number of syntactic occurrences. Previously we recorded just OneBranch or MultipleBranches. I thought this was going to be useful, but I ended up barely using it; see Note [Note [Suppress exponential blowup] in GHC.Core.Opt.Simplify.Utils Actual changes: * See the occ_n_br field of OneOcc. * postInlineUnconditionally 2. I found a small perf buglet in SetLevels; see the new function GHC.Core.Opt.SetLevels.hasFreeJoin 3. Remove the sc_cci field of StrictArg. I found I could get its information from the sc_fun field instead. Less to get wrong! 4. In ArgInfo, arrange that ai_dmds and ai_discs have a simpler invariant: they line up with the value arguments beyond ai_args This allowed a bit of nice refactoring; see isStrictArgInfo, lazyArgcontext, strictArgContext There is virtually no difference in nofib. (The runtime numbers are bogus -- I tried a few manually.) Program Size Allocs Runtime Elapsed TotalMem -------------------------------------------------------------------------------- fft +0.0% -2.0% -48.3% -49.4% 0.0% multiplier +0.0% -2.2% -50.3% -50.9% 0.0% -------------------------------------------------------------------------------- Min -0.4% -2.2% -59.2% -60.4% 0.0% Max +0.0% +0.1% +3.3% +4.9% 0.0% Geometric Mean +0.0% -0.0% -33.2% -34.3% -0.0% Test T18282 is an existing example of these deeply-nested strict calls. We get a big decrease in compile time (-85%) because so much less inlining takes place. Metric Decrease: T18282 - - - - - 6ee07b49 by Sylvain Henry at 2020-07-28T02:02:27-04:00 Bignum: add support for negative shifts (fix #18499) shiftR/shiftL support negative arguments despite Haskell 2010 report saying otherwise. We explicitly test for negative values which is bad (it gets in the way of constant folding, etc.). Anyway, for consistency we fix Bits instancesof Integer/Natural. - - - - - f305bbfd by Peter Trommler at 2020-07-28T02:03:02-04:00 config: Fix Haskell platform constructor w/ params Fixes #18505 - - - - - 318bb17c by Oleg Grenrus at 2020-07-28T20:54:13-04:00 Fix typo in haddock Spotted by `vilpan` on `#haskell` - - - - - 39c89862 by Sergei Trofimovich at 2020-07-28T20:54:50-04:00 ghc/mk: don't build gmp packages for BIGNUM_BACKEND=native Before this change make-based `BIGNUM_BACKEND=native` build was failing as: ``` x86_64-pc-linux-gnu-gcc: error: libraries/ghc-bignum/gmp/objs/*.o: No such file or directory ``` This happens because ghc.mk was pulling in gmp-dependent ghc-bignum library unconditionally. The change avoid building ghc-bignum. Bug: https://gitlab.haskell.org/ghc/ghc/-/issues/18437 Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org> - - - - - b9a880fc by Felix Wiemuth at 2020-07-29T15:06:35-04:00 Fix typo - - - - - c59064b0 by Brandon Chinn at 2020-07-29T15:07:11-04:00 Add regression test for #16341 - - - - - a61411ca by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass dit_rep_tc_args to dsm_stock_gen_fn - - - - - a26498da by Brandon Chinn at 2020-07-29T15:07:11-04:00 Pass tc_args to gen_fn - - - - - 44b11bad by Brandon Chinn at 2020-07-29T15:07:11-04:00 Filter out unreachable constructors when deriving stock instances (#16431) - - - - - bbc51916 by Simon Peyton Jones at 2020-07-29T15:07:47-04:00 Kill off sc_mult and as_mult fields They are readily derivable from other fields, so this is more efficient, and less error prone. Fixes #18494 - - - - - e3db4b4c by Peter Trommler at 2020-07-29T15:08:22-04:00 configure: Fix build system on ARM - - - - - 96c31ea1 by Sylvain Henry at 2020-07-29T15:09:02-04:00 Fix bug in Natural multiplication (fix #18509) A bug was lingering in Natural multiplication (inverting two limbs) despite QuickCheck tests used during the development leading to wrong results (independently of the selected backend). - - - - - e1dc3d7b by Krzysztof Gogolewski at 2020-07-29T15:09:39-04:00 Fix validation errors (#18510) Test T2632 is a stage1 test that failed because of the Q => Quote change. The remaining tests did not use quotation and failed when the path contained a space. - - - - - 6c68a842 by John Ericson at 2020-07-30T07:11:02-04:00 For `-fkeep-going` do not duplicate dependency edge code We now compute the deps for `-fkeep-going` the same way that the original graph calculates them, so the edges are correct. Upsweep really ought to take the graph rather than a topological sort so we are never recalculating anything, but at least things are recaluclated consistently now. - - - - - 502de556 by cgibbard at 2020-07-30T07:11:02-04:00 Add haddock comment for unfilteredEdges and move the note about drop_hs_boot_nodes into it. - - - - - 01c948eb by Ryan Scott at 2020-07-30T07:11:37-04:00 Clean up the inferred type variable restriction This patch primarily: * Documents `checkInferredVars` (previously called `check_inferred_vars`) more carefully. This is the function which throws an error message if a user quantifies an inferred type variable in a place where specificity cannot be observed. See `Note [Unobservably inferred type variables]` in `GHC.Rename.HsType`. Note that I now invoke `checkInferredVars` _alongside_ `rnHsSigType`, `rnHsWcSigType`, etc. rather than doing so _inside_ of these functions. This results in slightly more call sites for `checkInferredVars`, but it makes it much easier to enumerate the spots where the inferred type variable restriction comes into effect. * Removes the inferred type variable restriction for default method type signatures, per the discussion in #18432. As a result, this patch fixes #18432. Along the way, I performed some various cleanup: * I moved `no_nested_foralls_contexts_err` into `GHC.Rename.Utils` (under the new name `noNestedForallsContextsErr`), since it now needs to be invoked from multiple modules. I also added a helper function `addNoNestedForallsContextsErr` that throws the error message after producing it, as this is a common idiom. * In order to ensure that users cannot sneak inferred type variables into `SPECIALISE instance` pragmas by way of nested `forall`s, I now invoke `addNoNestedForallsContextsErr` when renaming `SPECIALISE instance` pragmas, much like when we rename normal instance declarations. (This probably should have originally been done as a part of the fix for #18240, but this task was somehow overlooked.) As a result, this patch fixes #18455 as a side effect. - - - - - d47324ce by Ryan Scott at 2020-07-30T07:12:16-04:00 Don't mark closed type family equations as occurrences Previously, `rnFamInstEqn` would mark the name of the type/data family used in an equation as an occurrence, regardless of what sort of family it is. Most of the time, this is the correct thing to do. The exception is closed type families, whose equations constitute its definition and therefore should not be marked as occurrences. Overzealously counting the equations of a closed type family as occurrences can cause certain warnings to not be emitted, as observed in #18470. See `Note [Type family equations and occurrences]` in `GHC.Rename.Module` for the full story. This fixes #18470 with a little bit of extra-casing in `rnFamInstEqn`. To accomplish this, I added an extra `ClosedTyFamInfo` field to the `NonAssocTyFamEqn` constructor of `AssocTyFamInfo` and refactored the relevant call sites accordingly so that this information is propagated to `rnFamInstEqn`. While I was in town, I moved `wrongTyFamName`, which checks that the name of a closed type family matches the name in an equation for that family, from the renamer to the typechecker to avoid the need for an `ASSERT`. As an added bonus, this lets us simplify the details of `ClosedTyFamInfo` a bit. - - - - - ebe2cf45 by Simon Peyton Jones at 2020-07-30T07:12:52-04:00 Remove an incorrect WARN in extendLocalRdrEnv I noticed this warning going off, and discovered that it's really fine. This small patch removes the warning, and docments what is going on. - - - - - 9f71f697 by Simon Peyton Jones at 2020-07-30T07:13:27-04:00 Add two bangs to improve perf of flattening This tiny patch improves the compile time of flatten-heavy programs by 1-2%, by adding two bangs. Addresses (somewhat) #18502 This reduces allocation by T9872b -1.1% T9872d -3.3% T5321Fun -0.2% T5631 -0.2% T5837 +0.1% T6048 +0.1% Metric Decrease: T9872b T9872d - - - - - 7c274cd5 by Sylvain Henry at 2020-07-30T22:54:48-04:00 Fix minimal imports dump for boot files (fix #18497) - - - - - 175cb5b4 by Sylvain Henry at 2020-07-30T22:55:25-04:00 DynFlags: don't use sdocWithDynFlags in datacon ppr We don't need to use `sdocWithDynFlags` to know whether we should display linear types for datacon types, we already have `sdocLinearTypes` field in `SDocContext`. Moreover we want to remove `sdocWithDynFlags` (#10143, #17957)). - - - - - 380638a3 by Sylvain Henry at 2020-07-30T22:56:03-04:00 Bignum: fix powMod for gmp backend (#18515) Also reenable integerPowMod test which had never been reenabled by mistake. - - - - - 56a7c193 by Sylvain Henry at 2020-07-31T19:32:09+02:00 Refactor CLabel pretty-printing Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove (#10143, #17957). It uses it to query the backend and the platform. This patch exposes Clabel ppr functions specialised for each backend so that backend code can directly use them. - - - - - 3b15dc3c by Sylvain Henry at 2020-07-31T19:32:09+02:00 DynFlags: don't use sdocWithDynFlags in GHC.CmmToAsm.Dwarf.Types - - - - - e30fed6c by Vladislav Zavialov at 2020-08-01T04:23:04-04:00 Test case for #17652 The issue was fixed by 19e80b9af252eee760dc047765a9930ef00067ec - - - - - 22641742 by Ryan Scott at 2020-08-02T16:44:11-04:00 Remove ConDeclGADTPrefixPs This removes the `ConDeclGADTPrefixPs` per the discussion in #18517. Most of this patch simply removes code, although the code in the `rnConDecl` case for `ConDeclGADTPrefixPs` had to be moved around a bit: * The nested `forall`s check now lives in the `rnConDecl` case for `ConDeclGADT`. * The `LinearTypes`-specific code that used to live in the `rnConDecl` case for `ConDeclGADTPrefixPs` now lives in `GHC.Parser.PostProcess.mkGadtDecl`, which is now monadic so that it can check if `-XLinearTypes` is enabled. Fixes #18157. - - - - - f2d1accf by Leon Schoorl at 2020-08-02T16:44:47-04:00 Fix GHC_STAGE definition generated by make Fixes #18070 GHC_STAGE is the stage of the compiler we're building, it should be 1,2(,3?). But make was generating 0 and 1. Hadrian does this correctly using a similar `+ 1`: https://gitlab.haskell.org/ghc/ghc/-/blob/eb8115a8c4cbc842b66798480fefc7ab64d31931/hadrian/src/Rules/Generate.hs#L245 - - - - - 947206f4 by Niklas Hambüchen at 2020-08-03T07:52:33+02:00 hadrian: Fix running stage0/bin/ghc with wrong package DB. Fixes #17468. In the invocation of `cabal configure`, `--ghc-pkg-option=--global-package-db` was already given correctly to tell `stage0/bin/ghc-pkg` that it should use the package DB in `stage1/`. However, `ghc` needs to be given this information as well, not only `ghc-pkg`! Until now that was not the case; the package DB in `stage0` was given to `ghc` instead. This was wrong, because there is no binary compatibility guarantee that says that the `stage0` DB's `package.cache` (which is written by the stage0 == system-provided ghc-pkg) can be deserialised by the `ghc-pkg` from the source code tree. As a result, when trying to add fields to `InstalledPackageInfo` that get serialised into / deserialised from the `package.cache`, errors like _build/stage0/lib/package.conf.d/package.cache: GHC.PackageDb.readPackageDb: inappropriate type (Not a valid Unicode code point!) would appear. This was because the `stage0/bin/ghc would try to deserialise the newly added fields from `_build/stage0/lib/package.conf.d/package.cache`, but they were not in there because the system `ghc-pkg` doesn't know about them and thus didn't write them there. It would try to do that because any GHC by default tries to read the global package db in `../lib/package.conf.d/package.cache`. For `stage0/bin/ghc` that *can never work* as explained above, so we must disable this default via `-no-global-package-db` and give it the correct package DB explicitly. This is the same problem as #16534, and the same fix as in MR !780 (but in another context; that one was for developers trying out the `stage0/bin/ghc` == `_build/ghc-stage1` interactively, while this fix is for a `cabal configure` invocation). I also noticed that the fix for #16534 forgot to pass `-no-global-package-db`, and have fixed that in this commit as well. It only worked until now because nobody tried to add a new ghc-pkg `.conf` field since the introduction of Hadrian. - - - - - ef2ae81a by Alex Biehl at 2020-08-03T07:52:33+02:00 Hardcode RTS includes to cope with unregistered builds - - - - - d613ed76 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add backward compat integer-gmp functions Also enhance bigNatCheck# and isValidNatural test - - - - - 3f2f7718 by Sylvain Henry at 2020-08-05T03:59:27-04:00 Bignum: add more BigNat compat functions in integer-gmp - - - - - 5e12cd17 by Krzysztof Gogolewski at 2020-08-05T04:00:04-04:00 Rename Core.Opt.Driver -> Core.Opt.Pipeline Closes #18504. - - - - - 2bff2f87 by Ben Gamari at 2020-08-05T04:00:39-04:00 Revert "iserv: Don't pass --export-dynamic on FreeBSD" This reverts commit 2290eb02cf95e9cfffcb15fc9c593d5ef79c75d9. - - - - - 53ce0db5 by Ben Gamari at 2020-08-05T04:00:39-04:00 Refactor handling of object merging Previously to merge a set of object files we would invoke the linker as usual, adding -r to the command-line. However, this can result in non-sensical command-lines which causes lld to balk (#17962). To avoid this we introduce a new tool setting into GHC, -pgmlm, which is the linker which we use to merge object files. - - - - - eb7013c3 by Hécate at 2020-08-05T04:01:15-04:00 Remove all the unnecessary LANGUAGE pragmas - - - - - fbcb886d by Ryan Scott at 2020-08-05T04:01:51-04:00 Make CodeQ and TExpQ levity polymorphic The patch is quite straightforward. The only tricky part is that `Language.Haskell.TH.Lib.Internal` now must be `Trustworthy` instead of `Safe` due to the `GHC.Exts` import (in order to import `TYPE`). Since `CodeQ` has yet to appear in any released version of `template-haskell`, I didn't bother mentioning the change to `CodeQ` in the `template-haskell` release notes. Fixes #18521. - - - - - 686e06c5 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Grammar for types and data/newtype constructors Before this patch, we parsed types into a reversed sequence of operators and operands. For example, (F x y + G a b * X) would be parsed as [X, *, b, a, G, +, y, x, F], using a simple grammar: tyapps : tyapp | tyapps tyapp tyapp : atype | PREFIX_AT atype | tyop | unpackedness Then we used a hand-written state machine to assemble this either into a type, using 'mergeOps', or into a constructor, using 'mergeDataCon'. This is due to a syntactic ambiguity: data T1 a = MkT1 a data T2 a = Ord a => MkT2 a In T1, what follows after the = sign is a data/newtype constructor declaration. However, in T2, what follows is a type (of kind Constraint). We don't know which of the two we are parsing until we encounter =>, and we cannot check for => without unlimited lookahead. This poses a few issues when it comes to e.g. infix operators: data I1 = Int :+ Bool :+ Char -- bad data I2 = Int :+ Bool :+ Char => MkI2 -- fine By this issue alone we are forced into parsing into an intermediate representation and doing a separate validation pass. However, should that intermediate representation be as low-level as a flat sequence of operators and operands? Before GHC Proposal #229, the answer was Yes, due to some particularly nasty corner cases: data T = ! A :+ ! B -- used to be fine, hard to parse data T = ! A :+ ! B => MkT -- bad However, now the answer is No, as this corner case is gone: data T = ! A :+ ! B -- bad data T = ! A :+ ! B => MkT -- bad This means we can write a proper grammar for types, overloading it in the DisambECP style, see Note [Ambiguous syntactic categories]. With this patch, we introduce a new class, DisambTD. Just like DisambECP is used to disambiguate between expressions, commands, and patterns, DisambTD is used to disambiguate between types and data/newtype constructors. This way, we get a proper, declarative grammar for constructors and types: infixtype : ftype | ftype tyop infixtype | unpackedness infixtype ftype : atype | tyop | ftype tyarg | ftype PREFIX_AT tyarg tyarg : atype | unpackedness atype And having a grammar for types means we are a step closer to using a single grammar for types and expressions. - - - - - 6770e199 by Vladislav Zavialov at 2020-08-06T13:34:05-04:00 Clean up the story around runPV/runECP_P/runECP_PV This patch started as a small documentation change, an attempt to make Note [Parser-Validator] and Note [Ambiguous syntactic categories] more clear and up-to-date. But it turned out that runECP_P/runECP_PV are weakly motivated, and it's easier to remove them than to find a good rationale/explanation for their existence. As the result, there's a bit of refactoring in addition to a documentation update. - - - - - 826d07db by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix debug_ppr_ty ForAllTy (#18522) Before this change, GHC would pretty-print forall k. forall a -> () as forall @k a. () which isn't even valid Haskell. - - - - - 0ddb4384 by Vladislav Zavialov at 2020-08-06T13:34:06-04:00 Fix visible forall in ppr_ty (#18522) Before this patch, this type: T :: forall k -> (k ~ k) => forall j -> k -> j -> Type was printed incorrectly as: T :: forall k j -> (k ~ k) => k -> j -> Type - - - - - d2a43225 by Richard Eisenberg at 2020-08-06T13:34:06-04:00 Fail eagerly on a lev-poly datacon arg Close #18534. See commentary in the patch. - - - - - 63348155 by Sylvain Henry at 2020-08-06T13:34:08-04:00 Use a type alias for Ways - - - - - 9570c212 by Takenobu Tani at 2020-08-06T19:46:46-04:00 users-guide: Rename 8.12 to 9.0 GHC 8.12.1 has been renamed to GHC 9.0.1. See also: https://mail.haskell.org/pipermail/ghc-devs/2020-July/019083.html [skip ci] - - - - - 3907ee01 by Cale Gibbard at 2020-08-07T08:34:46-04:00 A fix to an error message in monad comprehensions, and a move of dsHandleMonadicFailure as suggested by comments on !2330. - - - - - fa9bb70a by Cale Gibbard at 2020-08-07T08:34:46-04:00 Add some tests for fail messages in do-expressions and monad-comprehensions. - - - - - 5f036063 by Ben Gamari at 2020-08-07T08:35:21-04:00 cmm: Clean up Notes a bit - - - - - 6402c124 by Ben Gamari at 2020-08-07T08:35:21-04:00 CmmLint: Check foreign call argument register invariant As mentioned in Note [Register parameter passing] the arguments of foreign calls cannot refer to caller-saved registers. - - - - - 15b36de0 by Ben Gamari at 2020-08-07T08:35:21-04:00 nativeGen: One approach to fix #18527 Previously the code generator could produce corrupt C call sequences due to register overlap between MachOp lowerings and the platform's calling convention. We fix this using a hack described in Note [Evaluate C-call arguments before placing in destination registers]. - - - - - 3847ae0c by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Add test for #18527 - - - - - dd51d53b by Ben Gamari at 2020-08-07T08:35:21-04:00 testsuite: Fix prog001 Previously it failed as the `ghc` package was not visible. - - - - - e4f1b73a by Alan Zimmerman at 2020-08-07T23:58:10-04:00 ApiAnnotations; tweaks for ghc-exactprint update Remove unused ApiAnns, add one for linear arrow. Include API Annotations for trailing comma in export list. - - - - - 8a665db6 by Ben Gamari at 2020-08-07T23:58:45-04:00 configure: Fix double-negation in ld merge-objects check We want to only run the check if ld is gold. Fixes the fix to #17962. - - - - - a11c9678 by Adam Sandberg Ericsson at 2020-08-09T11:32:25+02:00 hadrian: depend on boot compiler version #18001 - - - - - c8873b52 by Alan Zimmerman at 2020-08-09T21:17:54-04:00 Api Annotations : Adjust SrcSpans for prefix bang (!). And prefix ~ (cherry picked from commit 8dbee2c578b1f642d45561be3f416119863e01eb) - - - - - 77398b67 by Sylvain Henry at 2020-08-09T21:18:34-04:00 Avoid allocations in `splitAtList` (#18535) As suspected by @simonpj in #18535, avoiding allocations in `GHC.Utils.Misc.splitAtList` when there are no leftover arguments is beneficial for performance: On CI validate-x86_64-linux-deb9-hadrian: T12227 -7% T12545 -12.3% T5030 -10% T9872a -2% T9872b -2.1% T9872c -2.5% Metric Decrease: T12227 T12545 T5030 T9872a T9872b T9872c - - - - - 8ba41a0f by Felix Yan at 2020-08-10T20:23:29-04:00 Correct a typo in ghc.mk - - - - - 1c469264 by Felix Yan at 2020-08-10T20:23:29-04:00 Add a closing parenthesis too - - - - - acf537f9 by Sylvain Henry at 2020-08-10T20:24:09-04:00 Make splitAtList strict in its arguments Also fix its slightly wrong comment Metric Decrease: T5030 T12227 T12545 - - - - - ab4d1589 by Ben Gamari at 2020-08-11T22:18:03-04:00 typecheck: Drop SPECIALISE pragmas when there is no unfolding Previously the desugarer would instead fall over when it realized that there was no unfolding for an imported function with a SPECIALISE pragma. We now rather drop the SPECIALISE pragma and throw a warning. Fixes #18118. - - - - - 0ac8c0a5 by Ben Gamari at 2020-08-11T22:18:03-04:00 testsuite: Add test for #18118 - - - - - c43078d7 by Sven Tennie at 2020-08-11T22:18:38-04:00 Add hie.yaml to ghc-heap This enables IDE support by haskell-language-server for ghc-heap. - - - - - f1088b3f by Ben Gamari at 2020-08-11T22:19:15-04:00 testsuite: Specify metrics collected by T17516 Previously it collected everything, including "max bytes used". This is problematic since the test makes no attempt to control for deviations in GC timing, resulting in high variability. Fix this by only collecting "bytes allocated". - - - - - accbc242 by Sylvain Henry at 2020-08-12T03:50:12-04:00 DynFlags: disentangle Outputable - put panic related functions into GHC.Utils.Panic - put trace related functions using DynFlags in GHC.Driver.Ppr One step closer making Outputable fully independent of DynFlags. Bump haddock submodule - - - - - db6dd810 by Ben Gamari at 2020-08-12T03:50:48-04:00 testsuite: Increase tolerance of T16916 T16916 (testing #16916) has been slightly fragile in CI due to its reliance on CPU times. While it's hard to see how to eliminate the time-dependence entirely, we can nevertheless make it more tolerant. Fixes #16966. - - - - - bee43aca by Sylvain Henry at 2020-08-12T20:52:50-04:00 Rewrite and move the monad-state hack note The note has been rewritten by @simonpj in !3851 [skip ci] - - - - - 25fdf25e by Alan Zimmerman at 2020-08-12T20:53:26-04:00 ApiAnnotations: Fix parser for new GHC 9.0 features - - - - - 7831fe05 by Ben Gamari at 2020-08-13T03:44:17-04:00 parser: Suggest ImportQualifiedPost in prepositive import warning As suggested in #18545. - - - - - 55dec4dc by Sebastian Graf at 2020-08-13T03:44:52-04:00 PmCheck: Better long-distance info for where bindings (#18533) Where bindings can see evidence from the pattern match of the `GRHSs` they belong to, but not from anything in any of the guards (which belong to one of possibly many RHSs). Before this patch, we did *not* consider said evidence, causing #18533, where the lack of considering type information from a case pattern match leads to failure to resolve the vanilla COMPLETE set of a data type. Making available that information required a medium amount of refactoring so that `checkMatches` can return a `[(Deltas, NonEmpty Deltas)]`; one `(Deltas, NonEmpty Deltas)` for each `GRHSs` of the match group. The first component of the pair is the covered set of the pattern, the second component is one covered set per RHS. Fixes #18533. Regression test case: T18533 - - - - - cf97889a by Hécate at 2020-08-13T03:45:29-04:00 Re-add BangPatterns to CodePage.hs - - - - - ffc0d578 by Sylvain Henry at 2020-08-13T09:49:56-04:00 Add HomeUnit type Since Backpack the "home unit" is much more involved than what it was before (just an identifier obtained with `-this-unit-id`). Now it is used in conjunction with `-component-id` and `-instantiated-with` to configure module instantiations and to detect if we are type-checking an indefinite unit or compiling a definite one. This patch introduces a new HomeUnit datatype which is much easier to understand. Moreover to make GHC support several packages in the same instances, we will need to handle several HomeUnits so having a dedicated (documented) type is helpful. Finally in #14335 we will also need to handle the case where we have no HomeUnit at all because we are only loading existing interfaces for plugins which live in a different space compared to units used to produce target code. Several functions will have to be refactored to accept "Maybe HomeUnit" parameters instead of implicitly querying the HomeUnit fields in DynFlags. Having a dedicated type will make this easier. Bump haddock submodule - - - - - 8a51b2ab by Sylvain Henry at 2020-08-13T21:09:15-04:00 Make IOEnv monad one-shot (#18202) On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated): T10421 -1.8% (threshold: +/- 1%) T10421a -1.7% (threshold: +/- 1%) T12150 -4.9% (threshold: +/- 2%) T12227 -1.6 (threshold: +/- 1%) T12425 -1.5% (threshold: +/- 1%) T12545 -3.8% (threshold: +/- 1%) T12707 -3.0% (threshold: +/- 1%) T13035 -3.0% (threshold: +/- 1%) T14683 -10.3% (threshold: +/- 2%) T3064 -6.9% (threshold: +/- 2%) T4801 -4.3% (threshold: +/- 2%) T5030 -2.6% (threshold: +/- 2%) T5321FD -3.6% (threshold: +/- 2%) T5321Fun -4.6% (threshold: +/- 2%) T5631 -19.7% (threshold: +/- 2%) T5642 -13.0% (threshold: +/- 2%) T783 -2.7 (threshold: +/- 2%) T9020 -11.1 (threshold: +/- 2%) T9961 -3.4% (threshold: +/- 2%) T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%) T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%) Additionally on other CIs: haddock.Cabal -10.0% (threshold: +/- 5%) haddock.compiler -9.5% (threshold: +/- 5%) haddock.base (max bytes used) +24.6% (threshold: +/- 15%) T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%) Metric Decrease: T10421 T10421a T12150 T12227 T12425 T12545 T12707 T13035 T14683 T3064 T4801 T5030 T5321FD T5321Fun T5631 T5642 T783 T9020 T9961 haddock.Cabal haddock.compiler Metric Decrease 'compile_time/bytes allocated': T1969 Metric Increase 'compile_time/max_bytes_used': T1969 T10370 haddock.base - - - - - 9f66fdf6 by Ben Gamari at 2020-08-14T15:50:34-04:00 testsuite: Drop --io-manager flag from testsuite configuration This is no longer necessary as there are now dedicated testsuite ways which run tests with WinIO. - - - - - 55fd1dc5 by Ben Gamari at 2020-08-14T15:51:10-04:00 llvm-targets: Add i686 targets Addresses #18422. - - - - - f4cc57fa by Ben Gamari at 2020-08-18T15:38:55-04:00 Allow unsaturated runRW# applications Previously we had a very aggressive Core Lint check which caught unsaturated applications of runRW#. However, there is nothing wrong with such applications and they may naturally arise in desugared Core. For instance, the desugared Core of Data.Primitive.Array.runArray# from the `primitive` package contains: case ($) (runRW# @_ @_) (\s -> ...) of ... In this case it's almost certain that ($) will be inlined, turning the application into a saturated application. However, even if this weren't the case there isn't a problem: CorePrep (after deleting an unnecessary case) can simply generate code in its usual way, resulting in a call to the Haskell definition of runRW#. Fixes #18291. - - - - - 3ac6ae7c by Ben Gamari at 2020-08-18T15:38:55-04:00 testsuite: Add test for #18291 - - - - - a87a0b49 by Eli Schwartz at 2020-08-18T15:39:30-04:00 install: do not install sphinx doctrees These files are 100% not needed at install time, and they contain unreproducible info. See https://reproducible-builds.org/ for why this matters. - - - - - 194b25ee by Ben Gamari at 2020-08-18T15:40:05-04:00 testsuite: Allow baseline commit to be set explicitly - - - - - fdcf7645 by Ben Gamari at 2020-08-18T15:40:05-04:00 gitlab-ci: Use MR base commit as performance baseline - - - - - 9ad5cab3 by Fendor at 2020-08-18T15:40:42-04:00 Expose UnitInfoMap as it is part of the public API - - - - - aa4b744d by Ben Gamari at 2020-08-18T22:11:36-04:00 testsuite: Only run llvm ways if llc is available As noted in #18560, we previously would always run the LLVM ways since `configure` would set `SettingsLlcCommand` to something non-null when it otherwise couldn't find the `llc` executable. Now we rather probe for the existence of the `llc` executable in the testsuite driver. Fixes #18560. - - - - - 0c5ed5c7 by Sylvain Henry at 2020-08-18T22:12:13-04:00 DynFlags: refactor GHC.CmmToAsm (#17957, #10143) This patch removes the use of `sdocWithDynFlags` from GHC.CmmToAsm.*.Ppr To do that I've had to make some refactoring: * X86' and PPC's `Instr` are no longer `Outputable` as they require a `Platform` argument * `Instruction` class now exposes `pprInstr :: Platform -> instr -> SDoc` * as a consequence, I've refactored some modules to avoid .hs-boot files * added (derived) functor instances for some datatypes parametric in the instruction type. It's useful for pretty-printing as we just have to map `pprInstr` before pretty-printing the container datatype. - - - - - 731c8d3b by nineonine at 2020-08-19T18:47:39-04:00 Implement -Wredundant-bang-patterns (#17340) Add new flag '-Wredundant-bang-patterns' that enables checks for "dead" bangs. Dead bangs are the ones that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs. The new check is performed in Pattern-Match Coverage Checker along with other checks (namely, redundant and inaccessible RHSs). Given f :: Bool -> Int f True = 1 f !x = 2 we can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. Note that we don't want to warn for a dead bang that appears on a redundant clause. That is because in that case, we recommend to delete the clause wholly, including its leading pattern match. Dead bang patterns are redundant. But there are bang patterns which are redundant that aren't dead, for example f !() = 0 the bang still forces the match variable, before we attempt to match on (). But it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. - - - - - eb9bdaef by Simon Peyton Jones at 2020-08-19T18:48:14-04:00 Add right-to-left rule for pattern bindings Fix #18323 by adding a few lines of code to handle non-recursive pattern bindings. see GHC.Tc.Gen.Bind Note [Special case for non-recursive pattern bindings] Alas, this confused the pattern-match overlap checker; see #18323. Note that this patch only affects pattern bindings like that for (x,y) in this program combine :: (forall a . [a] -> a) -> [forall a. a -> a] -> ((forall a . [a] -> a), [forall a. a -> a]) breaks = let (x,y) = combine head ids in x y True We need ImpredicativeTypes for those [forall a. a->a] types to be valid. And with ImpredicativeTypes the old, unprincipled "allow unification variables to unify with a polytype" story actually works quite well. So this test compiles fine (if delicatedly) with old GHCs; but not with QuickLook unless we add this patch - - - - - 293c7fba by Sylvain Henry at 2020-08-21T09:36:38-04:00 Put CFG weights into their own module (#17957) It avoids having to query DynFlags to get them - - - - - 50eb4460 by Sylvain Henry at 2020-08-21T09:36:38-04:00 Don't use DynFlags in CmmToAsm.BlockLayout (#17957) - - - - - 659eb31b by Sylvain Henry at 2020-08-21T09:36:38-04:00 NCG: Dwarf configuration * remove references to DynFlags in GHC.CmmToAsm.Dwarf * add specific Dwarf options in NCGConfig instead of directly querying the debug level - - - - - 2d8ca917 by Sylvain Henry at 2020-08-21T09:37:15-04:00 Fix -ddump-stg flag -ddump-stg was dumping the initial STG (just after Core-to-STG pass) which was misleading because we want the final STG to know if a function allocates or not. Now we have a new flag -ddump-stg-from-core for this and -ddump-stg is deprecated. - - - - - fddddbf4 by Vladislav Zavialov at 2020-08-21T09:37:49-04:00 Import qualified Prelude in Cmm/Parser.y In preparation for the next version of 'happy', c95920 added a qualified import to GHC/Parser.y but for some reason neglected GHC/Cmm/Parser.y This patch adds the missing qualified import to GHC/Cmm/Parser.y and also adds a clarifying comment to explain why this import is needed. - - - - - 989c1c27 by Ben Gamari at 2020-08-21T11:27:53-04:00 gitlab-ci: Test master branch as well While these builds are strictly speaking redundant (since every commit is tested by @marge-bot before making it into `master`), they are nevertheless useful as they are displayed in the branch's commit list in GitLab's web interface. Fixes #18595. - - - - - e67ae884 by Aditya Gupta at 2020-08-22T03:29:00-04:00 mkUnique refactoring (#18362) Move uniqFromMask from Unique.Supply to Unique. Move the the functions that call mkUnique from Unique to Builtin.Uniques - - - - - 03cfcfd4 by Wander Hillen at 2020-08-22T03:29:36-04:00 Add ubuntu 20.04 jobs for nightly and release - - - - - 3f501545 by Craig Ferguson at 2020-08-22T03:30:13-04:00 Utils: clarify docs slightly The previous comment implies `nTimes n f` is either `f^{n+1}` or `f^{2^n}` (when in fact it's `f^n`). - - - - - 8b865092 by Krzysztof Gogolewski at 2020-08-23T14:12:53+02:00 Do not print synonyms in :i (->), :i Type (#18594) This adds a new printing flag `sdocPrintTypeAbbreviations` that is used specifically to avoid ghci printing 'type (->) = (->)' and 'type Type = Type'. - - - - - d8f61182 by Krzysztof Gogolewski at 2020-08-23T14:12:56+02:00 Move pprTyTcApp' inside pprTyTcApp No semantic change - - - - - 364258e0 by Krzysztof Gogolewski at 2020-08-24T00:32:31-04:00 Fix types in silly shifts (#18589) Patch written by Simon. I have only added a testcase. - - - - - b1eb38a0 by Sylvain Henry at 2020-08-24T00:33:13-04:00 Perf: make SDoc monad one-shot (#18202) With validate-x86_64-linux-deb9-hadrian: T1969 -3.4% (threshold: +/-1%) T3294 -3.3% (threshold: +/-1%) T12707 -1.4% (threshold: +/-1%) Additionally with validate-x86_64-linux-deb9-unreg-hadrian: T4801 -2.4% (threshold: +/-2%) T13035 -1.4% (threshold: +/-1%) T13379 -2.4% (threshold: +/-2%) ManyAlternatives -2.5% (threshold: +/-2%) ManyConstructors -3.0% (threshold: +/-2%) Metric Decrease: T12707 T1969 T3294 ManyAlternatives ManyConstructors T13035 T13379 T4801 - - - - - a77b9ec2 by Krzysztof Gogolewski at 2020-08-24T10:04:20-04:00 Add a test for #18397 The bug was fixed by !3421. - - - - - 05550a5a by Sylvain Henry at 2020-08-24T10:04:59-04:00 Avoid roundtrip through SDoc As found by @monoidal on https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3885#note_295126 - - - - - 0a1ecc5f by Ben Gamari at 2020-08-25T07:37:05-04:00 SysTools.Process: Handle exceptions in readCreateProcessWithExitCode' In #18069 we are observing MVar deadlocks from somewhere in ghc.exe. This use of MVar stood out as being one of the more likely culprits. Here we make sure that it is exception-safe. - - - - - db8793ad by Richard Eisenberg at 2020-08-25T07:37:40-04:00 Use tcView, not coreView, in the pure unifier. Addresses a lingering point within #11715. - - - - - fb77207a by Simon Peyton Jones at 2020-08-25T07:38:16-04:00 Use LIdP rather than (XRec p (IdP p)) This patch mainly just replaces use of XRec p (IdP p) with LIdP p One slightly more significant change is to parameterise HsPatSynDetails over the pass rather than the argument type, so that it's uniform with HsConDeclDetails and HsConPatDetails. I also got rid of the dead code GHC.Hs.type.conDetailsArgs But this is all just minor refactoring. No change in functionality. - - - - - 8426a136 by Krzysztof Gogolewski at 2020-08-25T07:38:54-04:00 Add a test for #18585 - - - - - 2d635a50 by Takenobu Tani at 2020-08-26T04:50:21-04:00 linters: Make CPP linter skip image files This patch adds an exclusion rule for `docs/users_guide/images`, to avoid lint errors of PDF files. - - - - - b7d98cb2 by Takenobu Tani at 2020-08-26T04:50:21-04:00 users-guide: Color the logo on the front page of the PDF This patch updates the logo with a recent color scheme. This affects only the PDF version of the user's guide. See also: * https://mail.haskell.org/pipermail/ghc-devs/2020-August/019139.html * https://gitlab.haskell.org/ghc/ghc/-/wikis/logo - - - - - 0b17fa18 by Sylvain Henry at 2020-08-26T04:50:58-04:00 Refactor UnitId pretty-printing When we pretty-print a UnitId for the user, we try to map it back to its origin package name, version and component to print "package-version:component" instead of some hash. The UnitId type doesn't carry these information, so we have to look into a UnitState to find them. This is why the Outputable instance of UnitId used `sdocWithDynFlags` in order to access the `unitState` field of DynFlags. This is wrong for several reasons: 1. The DynFlags are accessed when the message is printed, not when it is generated. So we could imagine that the unitState may have changed in-between. Especially if we want to allow unit unloading. 2. We want GHC to support several independent sessions at once, hence several UnitState. The current approach supposes there is a unique UnitState as a UnitId doesn't indicate which UnitState to use. See the Note [Pretty-printing UnitId] in GHC.Unit for the new approach implemented by this patch. One step closer to remove `sdocDynFlags` field from `SDocContext` (#10143). Fix #18124. Also fix some Backpack code to use SDoc instead of String. - - - - - dc476a50 by Sylvain Henry at 2020-08-26T04:51:35-04:00 Bignum: fix BigNat subtraction (#18604) There was a confusion between the boolean expected by withNewWordArrayTrimedMaybe and the boolean returned by subtracting functions. - - - - - fcb10b6c by Peter Trommler at 2020-08-26T10:42:30-04:00 PPC and X86: Portable printing of IEEE floats GNU as and the AIX assembler support floating point literals. SPARC seems to have support too but I cannot test on SPARC. Curiously, `doubleToBytes` is also used in the LLVM backend. To avoid endianness issues when cross-compiling float and double literals are printed as C-style floating point values. The assembler then takes care of memory layout and endianness. This was brought up in #18431 by @hsyl20. - - - - - 770100e0 by Krzysztof Gogolewski at 2020-08-26T10:43:13-04:00 primops: Remove Monadic and Dyadic categories There were four categories of primops: Monadic, Dyadic, Compare, GenPrimOp. The compiler does not treat Monadic and Dyadic in any special way, we can just replace them with GenPrimOp. Compare is still used in isComparisonPrimOp. - - - - - 01ff8c89 by Aditya Gupta at 2020-08-27T14:19:26-04:00 Consolidate imports in getMinimalImports (#18264) - - - - - bacccb73 by Ryan Scott at 2020-08-27T14:20:01-04:00 Make {hsExpr,hsType,pat}NeedsParens aware of boxed 1-tuples `hsExprNeedsParens`, `hsTypeNeedsParens`, and `patNeedsParens` previously assumed that all uses of explicit tuples in the source syntax never need to be parenthesized. This is true save for one exception: boxed one-tuples, which use the `Solo` data type from `GHC.Tuple` instead of special tuple syntax. This patch adds the necessary logic to the three `*NeedsParens` functions to handle `Solo` correctly. Fixes #18612. - - - - - c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 37435ab8 by Ben Gamari at 2020-09-09T13:52:02-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 02a0875e by Ben Gamari at 2020-09-09T13:52:56-04:00 Bump version to 9.0 (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 19 changed files: - .ghcid - + .git-ignore-revs - .gitignore - .gitlab-ci.yml - + .gitlab/ci.sh - − .gitlab/darwin-init.sh - + .gitlab/linters/check-changelogs.sh - .gitlab/linters/check-cpp.py - .gitlab/merge_request_templates/merge-request.md - − .gitlab/prepare-system.sh - − .gitlab/push-test-metrics.sh - + .gitlab/test-metrics.sh - − .gitlab/win32-init.sh - .gitmodules - CODEOWNERS - HACKING.md - Makefile - aclocal.m4 - boot The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2534cef1a3d9bef5b4c7e675d19746f0db07502...02a0875effc3d17defafc164a2b5542b979e5196 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f2534cef1a3d9bef5b4c7e675d19746f0db07502...02a0875effc3d17defafc164a2b5542b979e5196 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 19:02:02 2020 From: gitlab at gitlab.haskell.org (Shayne Fletcher) Date: Wed, 09 Sep 2020 15:02:02 -0400 Subject: [Git][ghc/ghc][wip/T18599] Update test Message-ID: <5f5926aaaa788_80b3f8428d3124c1127917e@gitlab.haskell.org.mail> Spam detection software, running on the system "mail.haskell.org", has identified this incoming email as possible spam. The original message has been attached to this so you can view it (if it isn't spam) or label similar future email. If you have any questions, see @@CONTACT_ADDRESS@@ for details. Content preview: Shayne Fletcher pushed to branch wip/T18599 at Glasgow Haskell Compiler / GHC Commits: 4bf2315d by Shayne Fletcher at 2020-09-09T15:01:36-04:00 Update test - - - - - [...] Content analysis details: (5.0 points, 5.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- 1.1 URI_HEX URI: URI hostname has long hexadecimal sequence 5.0 UNWANTED_LANGUAGE_BODY BODY: Message written in an undesired language -1.9 BAYES_00 BODY: Bayes spam probability is 0 to 1% [score: 0.0000] 0.0 HTML_MESSAGE BODY: HTML included in message 0.8 RDNS_NONE Delivered to internal network by a host with no rDNS 0.0 T_DKIM_INVALID DKIM-Signature header exists but is not valid The original message was not completely plain text, and may be unsafe to open with some email clients; in particular, it may contain a virus, or confirm that your address can receive spam. If you wish to view it, it may be safer to save it to a file and open it with an editor. -------------- next part -------------- An embedded message was scrubbed... From: Shayne Fletcher Subject: [Git][ghc/ghc][wip/T18599] Update test Date: Wed, 09 Sep 2020 15:02:02 -0400 Size: 10767 URL: From gitlab at gitlab.haskell.org Wed Sep 9 20:00:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 16:00:00 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/initializers Message-ID: <5f593440eea90_80b72a920011283944@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/initializers at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/initializers You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 20:23:24 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 16:23:24 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f5939bc7456a_80b3f84a1f8987c1128573a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 2bc14a42 by Ben Gamari at 2020-09-09T16:23:15-04:00 Refactor foreign export tracking - - - - - 7 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,11 +91,12 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,23 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> exportsList) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbols) <> semi) ] + where + ctor_symbol = text "stginit_export_" <> pprFS mod + list_symbol = text "stg_exports_" <> pprFS mod + exportsList = braces + [ text "(StgPtr) &" <> ppr fn <> text "_closure" + | fn <- hs_fns + ] mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,104 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Things (e.g. CAFs) depended upon by `foreign export`s need to be kept alive + * for as long an object is loaded. To ensure this we create a stable pointer + * to each `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each object containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` object listing all of the exported closures, and + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the object is loaded its initializer is called by the linker (this + * might be the system's dynamic linker or GHC's own static linker). The + * `registerForeignExports` places the new `ForeignExportsList` on + * `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each. + * + * The reason for this two-step process is that in general we are very + * restricted in what we can do in an initializer function. For instance, we + * cannot necessarily call `malloc` since the `libc`'s own initializer may not + * have run yet. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObjects` and + * `foreignExportsFinishedLoadingObject`. We take note of the + * `ObjectCode*` we are loading in `loading_obj` such that we can + * associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < exports->n_entries; i++) { + StgPtr = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bc14a42f15f3bca5a84671926b51f284f550d54 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2bc14a42f15f3bca5a84671926b51f284f550d54 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 20:30:23 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 16:30:23 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f593b5fd1f07_80b3f84a06d6f3c112878cc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: d15ef2fc by Ben Gamari at 2020-09-09T16:29:25-04:00 Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 7 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,11 +91,12 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,23 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> exportsList) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbols) <> semi) ] + where + ctor_symbol = text "stginit_export_" <> pprFS mod + list_symbol = text "stg_exports_" <> pprFS mod + exportsList = braces + [ text "(StgPtr) &" <> ppr fn <> text "_closure" + | fn <- hs_fns + ] mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,106 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < exports->n_entries; i++) { + StgPtr = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d15ef2fc624bc99149599943a6a919c4d7b2b608 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d15ef2fc624bc99149599943a6a919c4d7b2b608 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 20:32:33 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 16:32:33 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f593be1abf8b_80b3f8477fe467011288268@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 10cfa115 by Ben Gamari at 2020-09-09T16:32:29-04:00 Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 7 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,11 +91,12 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,23 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> exportsList) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbols) <> semi) ] + where + ctor_symbol = text "stginit_export_" <> pprFS mod + list_symbol = text "stg_exports_" <> pprFS mod + exportsList = braces + [ text "(StgPtr) &" <> ppr fn <> text "_closure" + | fn <- hs_fns + ] mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,106 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < exports->n_entries; i++) { + StgPtr = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10cfa11500df537498fac080af1afd647b7be7d8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/10cfa11500df537498fac080af1afd647b7be7d8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 21:02:01 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 17:02:01 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18672 Message-ID: <5f5942c9ddbaf_80b3f848b5847981128866@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/T18672 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18672 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 21:03:18 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 17:03:18 -0400 Subject: [Git][ghc/ghc][wip/T18672] hadrian: Don't include -fdiagnostics-color in argument hash Message-ID: <5f5943165fbc9_80bf52841011290212@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/T18672 at Glasgow Haskell Compiler / GHC Commits: 9b81baca by GHC GitLab CI at 2020-09-09T21:03:09+00:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 2 changed files: - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Target.hs Changes: ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -35,6 +35,9 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do hasDynamic = elem dynamic ways mconcat [ arg "-Wall" , not useColor ? builder (Ghc CompileHs) ? + -- N.B. Target.trackArgument ignores this argument from the + -- input hash to avoid superfluous recompilation, avoiding + -- #18672. arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? ===================================== hadrian/src/Target.hs ===================================== @@ -21,11 +21,12 @@ type Target = H.Target Context Builder trackArgument :: Target -> String -> Bool trackArgument target arg = case builder target of Make _ -> not $ threadArg arg - Ghc _ _ -> not $ verbosityArg arg + Ghc _ _ -> not $ verbosityArg arg || diagnosticsColorArg arg Cabal _ _ -> not $ verbosityArg arg || cabal_configure_ignore arg _ -> True where threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="] verbosityArg s = dropWhileEnd isDigit s == "-v" + diagnosticsColorArg s = "-fdiagnostics-color=" `isPrefixOf` s -- N.B. #18672 cabal_configure_ignore s = s `elem` [ "--configure-option=--quiet", "--configure-option=--disable-option-checking" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b81baca848ea7e5d747e7bbe961caad0a07b3e0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b81baca848ea7e5d747e7bbe961caad0a07b3e0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 21:04:11 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 17:04:11 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/keepAlive-optionB Message-ID: <5f59434b7446b_80bf528410112906bb@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/keepAlive-optionB You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 21:22:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 17:22:47 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f5947a766868_80b3f8486235aec1129384@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: af27b537 by Ben Gamari at 2020-09-09T17:22:39-04:00 Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 8 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c - rts/RtsSymbols.c Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,11 +91,12 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,23 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> exportsList) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbols) <> semi) ] + where + ctor_symbol = text "stginit_export_" <> pprFS mod + list_symbol = text "stg_exports_" <> pprFS mod + exportsList = braces + [ text "(StgPtr) &" <> ppr fn <> text "_closure" + | fn <- hs_fns + ] mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,106 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < exports->n_entries; i++) { + StgPtr = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ ===================================== rts/RtsSymbols.c ===================================== @@ -652,7 +652,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af27b537041ef2e93066e24beb5c7c1df6f68e6c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af27b537041ef2e93066e24beb5c7c1df6f68e6c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 21:29:04 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 17:29:04 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 2 commits: base: Use keepAlive# in withForeignPtr Message-ID: <5f594920bf506_80bf5284101129431e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: 98a7b602 by Ben Gamari at 2020-09-09T21:09:09+00:00 base: Use keepAlive# in withForeignPtr - - - - - e09f8c4d by GHC GitLab CI at 2020-09-09T21:28:41+00:00 Simplify - - - - - 4 changed files: - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/CoreToStg/Prep.hs - libraries/base/Foreign/ForeignPtr/Imp.hs - libraries/base/GHC/ForeignPtr.hs Changes: ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -2011,16 +2011,20 @@ rebuildCall env fun_info rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont = rebuild env (argInfoExpr fun rev_args) cont +-- | Simplifications of runRW# and keepAlive# rebuildContOpCall :: SimplEnv -> ArgInfo -> SimplCont -> Maybe (SimplM (SimplFloats, OutExpr)) ----------- The runRW# rule. Do this after absorbing all arguments ------ --- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep. --- --- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o --- K[ runRW# rr ty body ] --> runRW rr' ty' (\s. K[ body s ]) rebuildContOpCall _env _arg_info cont | not (contIsStop cont) -- Don't fiddle around if the continuation is boring = Nothing +-- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep. +-- +-- N.B. runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). +-- (State# RealWorld -> o) -> o +-- +-- K[ runRW# rr ty body ] +-- ~> +-- runRW rr' ty' (\s. K[ body s ]) rebuildContOpCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) @@ -2033,9 +2037,10 @@ rebuildContOpCall ; let (m,_,_) = splitFunTy fun_ty env' = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s] ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s , sc_env = env', sc_cont = cont - , sc_hole_ty = mkVisFunTy m realWorldStatePrimTy ty' } + , sc_hole_ty = k'_ty } -- cont' applies to s, then K ; body' <- simplExprC env' arg cont' ; let arg' = Lam s body' @@ -2043,6 +2048,11 @@ rebuildContOpCall call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg ty', arg'] ; return (emptyFloats env, call') } +-- See Note [Simplification of keepAlive#] in GHC.CoreToStg.Prep. +-- +-- K[keepAlive# @a_rep @a @r_rep @r x s k] +-- ~> +-- keepAlive# @a_rep @a @r_rep @r x s K[k] rebuildContOpCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) @@ -2058,17 +2068,20 @@ rebuildContOpCall ] <- rev_args = Just $ do { s <- newId (fsLit "s") One realWorldStatePrimTy - ; let k_env = (k_se `setInScopeFromE` env) `addNewInScopeIds` [s] - k_cont = ApplyToVal { sc_dup = Simplified, sc_arg = Var s - , sc_env = k_env, sc_cont = cont, sc_hole_ty = undefined } + ; let (m,_,_) = splitFunTy fun_ty + k_env = (k_se `setInScopeFromE` env) `addNewInScopeIds` [s] + ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' + k_cont = ApplyToVal { sc_dup = Simplified, sc_arg = Var s + , sc_env = k_env, sc_cont = cont + , sc_hole_ty = k'_ty } ; k' <- simplExprC k_env k k_cont ; let env' = zapSubstEnv env ; s0' <- simplExpr env' s0 ; x' <- simplExpr env' x ; arg_rep' <- simplType env' arg_rep ; arg_ty' <- simplType env' arg_ty - ; let ty' = contResultType cont - call' = mkApps (Var fun_id) + ; let call' = mkApps (Var fun_id) [ mkTyArg arg_rep', mkTyArg arg_ty' , mkTyArg (getRuntimeRep ty'), mkTyArg ty' , x' ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1096,10 +1096,26 @@ Breaking our desired invariant. Ultimately we decided to simply accept that the continuation may not be a manifest lambda. +Note [Simplification of keepAlive#] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The keepAlive# primop benefits from a similar optimisation to that described in +Note [Simplification of runRW#] above. Specifically, we transform: + + K[keepAlive# @a_rep @a @r_rep @r x s k] + ~> + keepAlive# @a_rep @a @r_rep @r x s K[k] + +The reasons are similar to those described in Note [Simplification of runRW#]. + +-} + + -- --------------------------------------------------------------------------- -- CpeArg: produces a result satisfying CpeArg -- --------------------------------------------------------------------------- +{- Note [ANF-ising literal string arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== libraries/base/Foreign/ForeignPtr/Imp.hs ===================================== @@ -66,31 +66,6 @@ newForeignPtr finalizer p addForeignPtrFinalizer finalizer fObj return fObj -withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b --- ^This is a way to look at the pointer living inside a --- foreign object. This function takes a function which is --- applied to that pointer. The resulting 'IO' action is then --- executed. The foreign object is kept alive at least during --- the whole action, even if it is not used directly --- inside. Note that it is not safe to return the pointer from --- the action and use it after the action completes. All uses --- of the pointer should be inside the --- 'withForeignPtr' bracket. The reason for --- this unsafeness is the same as for --- 'unsafeForeignPtrToPtr' below: the finalizer --- may run earlier than expected, because the compiler can only --- track usage of the 'ForeignPtr' object, not --- a 'Ptr' object made from it. --- --- This function is normally used for marshalling data to --- or from the object pointed to by the --- 'ForeignPtr', using the operations from the --- 'Storable' class. -withForeignPtr fo io - = do r <- io (unsafeForeignPtrToPtr fo) - touchForeignPtr fo - return r - -- | This variant of 'newForeignPtr' adds a finalizer that expects an -- environment in addition to the finalized pointer. The environment -- that will be passed to the finalizer is fixed by the second argument to ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -46,6 +46,7 @@ module GHC.ForeignPtr castForeignPtr, plusForeignPtr, -- * Finalization + withForeignPtr, touchForeignPtr, finalizeForeignPtr -- * Commentary @@ -60,6 +61,7 @@ import GHC.Base import GHC.IORef import GHC.STRef ( STRef(..) ) import GHC.Ptr ( Ptr(..), FunPtr(..) ) +import GHC.Prim ( keepAlive# ) import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) @@ -503,6 +505,31 @@ newForeignPtr_ (Ptr obj) = do r <- newIORef NoFinalizers return (ForeignPtr obj (PlainForeignPtr r)) +withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +-- ^This is a way to look at the pointer living inside a +-- foreign object. This function takes a function which is +-- applied to that pointer. The resulting 'IO' action is then +-- executed. The foreign object is kept alive at least during +-- the whole action, even if it is not used directly +-- inside. Note that it is not safe to return the pointer from +-- the action and use it after the action completes. All uses +-- of the pointer should be inside the +-- 'withForeignPtr' bracket. The reason for +-- this unsafeness is the same as for +-- 'unsafeForeignPtrToPtr' below: the finalizer +-- may run earlier than expected, because the compiler can only +-- track usage of the 'ForeignPtr' object, not +-- a 'Ptr' object made from it. +-- +-- This function is normally used for marshalling data to +-- or from the object pointed to by the +-- 'ForeignPtr', using the operations from the +-- 'Storable' class. +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> + case f (unsafeForeignPtrToPtr fo) of + IO action# -> keepAlive# r s action# + + touchForeignPtr :: ForeignPtr a -> IO () -- ^This function ensures that the foreign object in -- question is alive at the given place in the sequence of IO View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84923598ec40dffaa9d2ab5712c63795d63f854c...e09f8c4d7f87c703a5428723354f8527a3420e1e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/84923598ec40dffaa9d2ab5712c63795d63f854c...e09f8c4d7f87c703a5428723354f8527a3420e1e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 22:10:50 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 18:10:50 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 19 commits: rts: Add stg_copyArray_barrier to RtsSymbols list Message-ID: <5f5952eae8411_80b3f8496298dbc1129627c@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 1f5f80b7 by Ben Gamari at 2020-09-09T22:10:45+00:00 genprimopcode: Add a second levity-polymorphic tyvar - - - - - adc7d7fb by GHC GitLab CI at 2020-09-09T22:10:45+00:00 keepAlive primop - - - - - 3ec4667e by Ben Gamari at 2020-09-09T22:10:45+00:00 base: Use keepAlive# in alloca, et al. - - - - - 67c1567a by GHC GitLab CI at 2020-09-09T22:10:45+00:00 Simplify: Factor out runRW rule - - - - - cdf08d44 by GHC GitLab CI at 2020-09-09T22:10:45+00:00 Simplify - - - - - 19bfd54c by GHC GitLab CI at 2020-09-09T22:10:45+00:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #17983. - - - - - d2e6cd11 by Ben Gamari at 2020-09-09T22:10:46+00:00 base: Use keepAlive# in withForeignPtr - - - - - 30 changed files: - .gitlab/ci.sh - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/SimpleOpt.hs - + compiler/GHC/Core/SimpleOpt.hs-boot - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold.hs-boot - + compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - + compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e09f8c4d7f87c703a5428723354f8527a3420e1e...d2e6cd111af1d50ceb4a36d7a17f7a892297f6f0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e09f8c4d7f87c703a5428723354f8527a3420e1e...d2e6cd111af1d50ceb4a36d7a17f7a892297f6f0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 22:13:25 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 18:13:25 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f5953857195_80b3f8468ca2cf011296862@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: cee2ea47 by Ben Gamari at 2020-09-09T18:13:17-04:00 Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 8 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c - rts/RtsSymbols.c Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,11 +91,12 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,24 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = moduleStableString mod + ctor_symbol = text "stginit_export_" <> ppr mod_str + list_symbol = text "stg_exports_" <> text mod_str + export_list = braces + [ text "(StgPtr) &" <> ppr fn <> text "_closure" + | fn <- hs_fns + ] mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,106 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < exports->n_entries; i++) { + StgPtr = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ ===================================== rts/RtsSymbols.c ===================================== @@ -652,7 +652,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cee2ea471c3c84d0c06de2623b01af1750f0fcef -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cee2ea471c3c84d0c06de2623b01af1750f0fcef You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 22:18:42 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 18:18:42 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] 20 commits: Add clarification regarding poll/kqueue flags Message-ID: <5f5954c23f134_80b3f8475507e4811304414@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 9c6c1ebc by Ben Gamari at 2020-09-09T18:18:33-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - 47b0187d by Ben Gamari at 2020-09-09T18:18:33-04:00 Bump version to 9.0 (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 8ae323de by Ben Gamari at 2020-09-09T18:18:33-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/SimpleOpt.hs - + compiler/GHC/Core/SimpleOpt.hs-boot - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold.hs-boot - + compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - + compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs - compiler/GHC/Driver/Pipeline.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/844f8dbafa16b5049da79ec783c66917ef62b9ce...8ae323deae5b08bbce156cbbd106596affe05d65 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/844f8dbafa16b5049da79ec783c66917ef62b9ce...8ae323deae5b08bbce156cbbd106596affe05d65 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 22:31:46 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 09 Sep 2020 18:31:46 -0400 Subject: [Git][ghc/ghc][master] 3 commits: gitlab-ci: Bump Docker images Message-ID: <5f5957d237bd5_80b3f8460659504113051d0@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 8 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - testsuite/tests/module/mod184.stderr - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: e1cdfaea745989faa266f09c1d6c4c981aa34dc6 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10: + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: @@ -1082,8 +1082,8 @@ perf-nofib: make install popd rm -Rf tmp - - export BOOT_HC=$(which ghc) - - cabal update; cabal install -w $BOOT_HC regex-compat + - export BOOT_HC=$GHC + - cabal update; cabal install -w "$BOOT_HC" --lib regex-compat - export PATH=$root/bin:$PATH - make -C nofib boot mode=fast -j$CPUS - "make -C nofib EXTRA_RUNTEST_OPTS='-cachegrind +RTS -V0 -RTS' NoFibRuns=1 mode=fast -j$CPUS 2>&1 | tee nofib.log" ===================================== .gitlab/ci.sh ===================================== @@ -152,22 +152,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -204,12 +208,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -233,12 +237,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -279,7 +283,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -1,3 +1,4 @@ + mod184.hs:6:8: warning: [-Wprepositive-qualified-module] Found ‘qualified’ in prepositive position Suggested fix: place ‘qualified’ after the module name instead. ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7911d0d983a68eb0d54d7c1ba51326d6be737aae...291a15dd8dfc03d493c0db36a9cb62fd4867db10 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7911d0d983a68eb0d54d7c1ba51326d6be737aae...291a15dd8dfc03d493c0db36a9cb62fd4867db10 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 22:32:24 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Wed, 09 Sep 2020 18:32:24 -0400 Subject: [Git][ghc/ghc][master] rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c Message-ID: <5f5957f8d9e2_80b3f848aa8ccf011310011@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 1 changed file: - includes/stg/Ticky.h Changes: ===================================== includes/stg/Ticky.h ===================================== @@ -19,7 +19,7 @@ /* Here are all the counter declarations: */ /* If you change this list, make the corresponding change - in RTS_TICKY_SYMBOLS in rts/Linker.c */ + in RTS_TICKY_SYMBOLS in rts/RtsSymbols.c */ /* These two are explicitly declared in rts/Ticky.c, and hence should not be extern'd except when using this header View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4798caa0fefd7adf4c5b85fa84a6f28fcc6b350b -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4798caa0fefd7adf4c5b85fa84a6f28fcc6b350b You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 22:55:30 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 18:55:30 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/backports Message-ID: <5f595d621c5e5_80b3f849cb6311c113102c2@gitlab.haskell.org.mail> Ben Gamari pushed new branch wip/backports at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/backports You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 23:13:50 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 19:13:50 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f5961aed9606_80b3f84644d8ed81131303@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 5f072ad4 by Ben Gamari at 2020-09-09T19:13:40-04:00 Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 8 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c - rts/RtsSymbols.c Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,15 +91,16 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) - (vcat cs $$ vcat fe_init_code), + (vcat cs $$ fe_init_code), foldr (appOL . toOL) nilOL bindss) where do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,24 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = moduleStableString mod + ctor_symbol = text "stginit_export_" <> ppr mod_str + list_symbol = text "stg_exports_" <> text mod_str + export_list = braces $ pprWithComma closure_ptr hs_fns + + closure_ptr :: Id -> SDoc + closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure" mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,106 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < exports->n_entries; i++) { + StgPtr = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ ===================================== rts/RtsSymbols.c ===================================== @@ -652,7 +652,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f072ad4f3378ac0d42ecd48b7e2480c2c4b7699 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f072ad4f3378ac0d42ecd48b7e2480c2c4b7699 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Wed Sep 9 23:46:06 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 19:46:06 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f59693e8be7_80b3f848befca50113136d2@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 93f52f7e by Ben Gamari at 2020-09-09T19:45:49-04:00 Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 8 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c - rts/RtsSymbols.c Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,15 +91,16 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) - (vcat cs $$ vcat fe_init_code), + (vcat cs $$ fe_init_code), foldr (appOL . toOL) nilOL bindss) where do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,24 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = moduleStableString mod + ctor_symbol = text "stginit_export_" <> ppr mod_str + list_symbol = text "stg_exports_" <> text mod_str + export_list = braces $ pprWithCommas closure_ptr hs_fns + + closure_ptr :: Id -> SDoc + closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure" mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,106 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < exports->n_entries; i++) { + StgPtr = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ ===================================== rts/RtsSymbols.c ===================================== @@ -652,7 +652,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93f52f7e39a4adc9cc090b4270c66a6c8492d80a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/93f52f7e39a4adc9cc090b4270c66a6c8492d80a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 00:08:09 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Wed, 09 Sep 2020 20:08:09 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] Drop redundant import Message-ID: <5f596e69eec4e_80b3f84a0817748113162da@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: ef969940 by GHC GitLab CI at 2020-09-10T00:08:01+00:00 Drop redundant import - - - - - 1 changed file: - libraries/base/GHC/ForeignPtr.hs Changes: ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -61,7 +61,6 @@ import GHC.Base import GHC.IORef import GHC.STRef ( STRef(..) ) import GHC.Ptr ( Ptr(..), FunPtr(..) ) -import GHC.Prim ( keepAlive# ) import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef969940fbceddabb35a0d6055a991462fe7c608 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef969940fbceddabb35a0d6055a991462fe7c608 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 04:10:47 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 00:10:47 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 2 commits: base: Use keepAlive# in withForeignPtr Message-ID: <5f59a747c5c4f_80b3f8495b39a80113250dc@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: c7fa0e40 by Ben Gamari at 2020-09-10T03:10:03+00:00 base: Use keepAlive# in withForeignPtr - - - - - 2cc7cc8e by GHC GitLab CI at 2020-09-10T03:10:03+00:00 base: Make touchForeignPtr more robust Previously touchForeignPtr would touch the ForeignPtr's associated ForeignPtrContents. However, this is a normal constructor and therefore can be eliminated by the simplifier. To ensure that the foreign pointer's contents isn't dropped we need to rather `touch#` the underlying array (which is the same thing that we key the `Weak` on when adding finalizers). - - - - - 2 changed files: - libraries/base/Foreign/ForeignPtr/Imp.hs - libraries/base/GHC/ForeignPtr.hs Changes: ===================================== libraries/base/Foreign/ForeignPtr/Imp.hs ===================================== @@ -66,31 +66,6 @@ newForeignPtr finalizer p addForeignPtrFinalizer finalizer fObj return fObj -withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b --- ^This is a way to look at the pointer living inside a --- foreign object. This function takes a function which is --- applied to that pointer. The resulting 'IO' action is then --- executed. The foreign object is kept alive at least during --- the whole action, even if it is not used directly --- inside. Note that it is not safe to return the pointer from --- the action and use it after the action completes. All uses --- of the pointer should be inside the --- 'withForeignPtr' bracket. The reason for --- this unsafeness is the same as for --- 'unsafeForeignPtrToPtr' below: the finalizer --- may run earlier than expected, because the compiler can only --- track usage of the 'ForeignPtr' object, not --- a 'Ptr' object made from it. --- --- This function is normally used for marshalling data to --- or from the object pointed to by the --- 'ForeignPtr', using the operations from the --- 'Storable' class. -withForeignPtr fo io - = do r <- io (unsafeForeignPtrToPtr fo) - touchForeignPtr fo - return r - -- | This variant of 'newForeignPtr' adds a finalizer that expects an -- environment in addition to the finalized pointer. The environment -- that will be passed to the finalizer is fixed by the second argument to ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -3,6 +3,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} {-# OPTIONS_HADDOCK not-home #-} @@ -46,6 +48,7 @@ module GHC.ForeignPtr castForeignPtr, plusForeignPtr, -- * Finalization + withForeignPtr, touchForeignPtr, finalizeForeignPtr -- * Commentary @@ -55,6 +58,7 @@ module GHC.ForeignPtr import Foreign.Storable import Data.Foldable ( sequence_ ) +import GHC.Types import GHC.Show import GHC.Base import GHC.IORef @@ -124,7 +128,7 @@ data ForeignPtrContents -- ^ The pointer refers to unmanaged memory that should not be freed when -- the 'ForeignPtr' becomes unreachable. Functions that add finalizers -- to a 'ForeignPtr' throw exceptions when the 'ForeignPtr' is backed by - -- 'PlainPtr'Most commonly, this is used with @Addr#@ literals. + -- 'PlainPtr'. Most commonly, this is used with @Addr#@ literals. -- See Note [Why FinalPtr]. -- -- @since 4.15 @@ -162,6 +166,7 @@ data ForeignPtrContents -- The invariants that apply to 'MallocPtr' apply to 'PlainPtr' as well. -- Note [Why FinalPtr] +-- ~~~~~~~~~~~~~~~~~~~ -- -- FinalPtr exists as an optimization for foreign pointers created -- from Addr# literals. Most commonly, this happens in the bytestring @@ -428,7 +433,7 @@ addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do else return () where finalizer' :: State# RealWorld -> (# State# RealWorld, () #) - finalizer' = unIO (foreignPtrFinalizer r >> touch f) + finalizer' = unIO (foreignPtrFinalizer r >> touchForeignPtrContents f) addForeignPtrConcFinalizer_ _ _ = errorWithoutStackTrace "GHC.ForeignPtr: attempt to add a finalizer to plain pointer or a final pointer" @@ -503,6 +508,36 @@ newForeignPtr_ (Ptr obj) = do r <- newIORef NoFinalizers return (ForeignPtr obj (PlainForeignPtr r)) +withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +-- ^This is a way to look at the pointer living inside a +-- foreign object. This function takes a function which is +-- applied to that pointer. The resulting 'IO' action is then +-- executed. The foreign object is kept alive at least during +-- the whole action, even if it is not used directly +-- inside. Note that it is not safe to return the pointer from +-- the action and use it after the action completes. All uses +-- of the pointer should be inside the +-- 'withForeignPtr' bracket. The reason for +-- this unsafeness is the same as for +-- 'unsafeForeignPtrToPtr' below: the finalizer +-- may run earlier than expected, because the compiler can only +-- track usage of the 'ForeignPtr' object, not +-- a 'Ptr' object made from it. +-- +-- This function is normally used for marshalling data to +-- or from the object pointed to by the +-- 'ForeignPtr', using the operations from the +-- 'Storable' class. +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> + case f (unsafeForeignPtrToPtr fo) of + IO action# -> + case r of + PlainForeignPtr ref -> keepAlive# ref s action# + FinalPtr -> action# s + MallocPtr mba _ -> keepAlive# mba s action# + PlainPtr mba -> keepAlive# mba s action# + + touchForeignPtr :: ForeignPtr a -> IO () -- ^This function ensures that the foreign object in -- question is alive at the given place in the sequence of IO @@ -528,10 +563,19 @@ touchForeignPtr :: ForeignPtr a -> IO () -- result in artificial deadlock. Another alternative is to use -- explicit reference counting. -- -touchForeignPtr (ForeignPtr _ r) = touch r +touchForeignPtr (ForeignPtr _ r) = touchForeignPtrContents r + +touchForeignPtrContents :: ForeignPtrContents -> IO () +touchForeignPtrContents (PlainForeignPtr ref) = touchLifted ref +touchForeignPtrContents FinalPtr = return () +touchForeignPtrContents (MallocPtr mba _) = touchUnlifted mba +touchForeignPtrContents (PlainPtr mba) = touchUnlifted mba + +touchLifted :: a -> IO () +touchLifted r = IO $ \s -> case touch# r s of s' -> (# s', () #) -touch :: ForeignPtrContents -> IO () -touch r = IO $ \s -> case touch# r s of s' -> (# s', () #) +touchUnlifted :: forall (a :: TYPE 'UnliftedRep). a -> IO () +touchUnlifted r = IO $ \s -> case touch# r s of s' -> (# s', () #) unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a -- ^This function extracts the pointer component of a foreign View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef969940fbceddabb35a0d6055a991462fe7c608...2cc7cc8ec7c85457a5b59089d6f6efe6b5c9002e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ef969940fbceddabb35a0d6055a991462fe7c608...2cc7cc8ec7c85457a5b59089d6f6efe6b5c9002e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 05:30:00 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 01:30:00 -0400 Subject: [Git][ghc/ghc][wip/bump-version] 5 commits: gitlab-ci: Bump Docker images Message-ID: <5f59b9d8e1654_80b3f847cc92d6411326833@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-version at Glasgow Haskell Compiler / GHC Commits: 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - c91e0048 by Ben Gamari at 2020-09-10T01:29:52-04:00 Bump version to 9.0 (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 11 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - configure.ac - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - includes/stg/Ticky.h - testsuite/tests/module/mod184.stderr - utils/haddock - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: e1cdfaea745989faa266f09c1d6c4c981aa34dc6 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10: + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: @@ -1082,8 +1082,8 @@ perf-nofib: make install popd rm -Rf tmp - - export BOOT_HC=$(which ghc) - - cabal update; cabal install -w $BOOT_HC regex-compat + - export BOOT_HC=$GHC + - cabal update; cabal install -w "$BOOT_HC" --lib regex-compat - export PATH=$root/bin:$PATH - make -C nofib boot mode=fast -j$CPUS - "make -C nofib EXTRA_RUNTEST_OPTS='-cachegrind +RTS -V0 -RTS' NoFibRuns=1 mode=fast -j$CPUS 2>&1 | tee nofib.log" ===================================== .gitlab/ci.sh ===================================== @@ -152,22 +152,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -204,12 +208,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -233,12 +237,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -279,7 +283,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== 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.11.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.0.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== includes/stg/Ticky.h ===================================== @@ -19,7 +19,7 @@ /* Here are all the counter declarations: */ /* If you change this list, make the corresponding change - in RTS_TICKY_SYMBOLS in rts/Linker.c */ + in RTS_TICKY_SYMBOLS in rts/RtsSymbols.c */ /* These two are explicitly declared in rts/Ticky.c, and hence should not be extern'd except when using this header ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -1,3 +1,4 @@ + mod184.hs:6:8: warning: [-Wprepositive-qualified-module] Found ‘qualified’ in prepositive position Suggested fix: place ‘qualified’ after the module name instead. ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 +Subproject commit b95f6f29899a8a58223732a6633a47a35b8f1d6a ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02a0875effc3d17defafc164a2b5542b979e5196...c91e00482fae0f89eb35a00a2b565aa73c9292bc -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/02a0875effc3d17defafc164a2b5542b979e5196...c91e00482fae0f89eb35a00a2b565aa73c9292bc You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 05:30:32 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 01:30:32 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] Alloc Message-ID: <5f59b9f8c6464_80b3f8439b65970113272c4@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: 86888d09 by GHC GitLab CI at 2020-09-10T05:30:25+00:00 Alloc - - - - - 1 changed file: - libraries/base/Foreign/Marshal/Alloc.hs Changes: ===================================== libraries/base/Foreign/Marshal/Alloc.hs ===================================== @@ -68,7 +68,6 @@ import GHC.IO.Exception import GHC.Real import GHC.Ptr import GHC.Base -import GHC.Prim ( keepAlive# ) -- exported functions -- ------------------ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86888d093a16f8fe9ef7cff0d8b24b12619e3180 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/86888d093a16f8fe9ef7cff0d8b24b12619e3180 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 05:31:56 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 01:31:56 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] 7 commits: gitlab-ci: Bump Docker images Message-ID: <5f59ba4c8c4a2_80b3f8439b659701132763f@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - a3f4dc1a by Ben Gamari at 2020-09-10T01:31:44-04:00 rts/win32: Fix missing #include's These slipped through CI. - - - - - b197e57d by Ben Gamari at 2020-09-10T01:31:44-04:00 Bump Win32 submodule to 2.9.0.0 Also bumps Cabal, directory - - - - - b62eed7a by Ben Gamari at 2020-09-10T01:31:44-04:00 Bump version to 9.0 (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 21 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/ghc.cabal.in - configure.ac - ghc/ghc-bin.cabal.in - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - includes/stg/Ticky.h - libraries/Cabal - libraries/directory - libraries/haskeline - rts/win32/IOManager.c - rts/win32/WorkQueue.c - testsuite/tests/module/mod184.stderr - utils/check-api-annotations/check-api-annotations.cabal - utils/check-ppr/check-ppr.cabal - utils/ghc-cabal/ghc-cabal.cabal - utils/haddock - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: e1cdfaea745989faa266f09c1d6c4c981aa34dc6 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10: + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: @@ -1082,8 +1082,8 @@ perf-nofib: make install popd rm -Rf tmp - - export BOOT_HC=$(which ghc) - - cabal update; cabal install -w $BOOT_HC regex-compat + - export BOOT_HC=$GHC + - cabal update; cabal install -w "$BOOT_HC" --lib regex-compat - export PATH=$root/bin:$PATH - make -C nofib boot mode=fast -j$CPUS - "make -C nofib EXTRA_RUNTEST_OPTS='-cachegrind +RTS -V0 -RTS' NoFibRuns=1 mode=fast -j$CPUS 2>&1 | tee nofib.log" ===================================== .gitlab/ci.sh ===================================== @@ -152,22 +152,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -204,12 +208,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -233,12 +237,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -279,7 +283,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== compiler/ghc.cabal.in ===================================== @@ -77,7 +77,7 @@ Library ghci == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else if flag(terminfo) Build-Depends: terminfo == 0.4.* ===================================== 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.11.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.0.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} ===================================== ghc/ghc-bin.cabal.in ===================================== @@ -45,7 +45,7 @@ Executable ghc ghc == @ProjectVersionMunged@ if os(windows) - Build-Depends: Win32 >= 2.3 && < 2.7 + Build-Depends: Win32 >= 2.3 && < 2.10 else Build-Depends: unix >= 2.7 && < 2.9 @@ -102,4 +102,4 @@ Executable ghc Default-Extensions: NoImplicitPrelude , ScopedTypeVariables - , BangPatterns \ No newline at end of file + , BangPatterns ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== includes/stg/Ticky.h ===================================== @@ -19,7 +19,7 @@ /* Here are all the counter declarations: */ /* If you change this list, make the corresponding change - in RTS_TICKY_SYMBOLS in rts/Linker.c */ + in RTS_TICKY_SYMBOLS in rts/RtsSymbols.c */ /* These two are explicitly declared in rts/Ticky.c, and hence should not be extern'd except when using this header ===================================== libraries/Cabal ===================================== @@ -1 +1 @@ -Subproject commit 32dad5c1cf70d65ecb93b0ec214445cf9c9f6615 +Subproject commit 2d8a1b60ae409291585b647be8f02bc42b23cbbb ===================================== libraries/directory ===================================== @@ -1 +1 @@ -Subproject commit 3d9ca6edc0703860829ab3210db78bb4c4ff72b9 +Subproject commit c16afcda5708ee9944afa7ea6858e5be894fe67e ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 5f16b76168f13c6413413386efc44fb1152048d5 +Subproject commit 1b4f19ef56adc86a860884363d3dcb19bc09d01b ===================================== rts/win32/IOManager.c ===================================== @@ -11,6 +11,7 @@ #if !defined(THREADED_RTS) #include "Rts.h" +#include "RtsUtils.h" #include "IOManager.h" #include "WorkQueue.h" #include "ConsoleHandler.h" @@ -440,7 +441,7 @@ AddIORequest ( int fd, { ASSERT(ioMan); - WorkItem* wItem = (WorkItem*)stgMallocBytse(sizeof(WorkItem), "AddIORequest"); + WorkItem* wItem = (WorkItem*)stgMallocBytes(sizeof(WorkItem), "AddIORequest"); unsigned int reqID = ioMan->requestID++; ===================================== rts/win32/WorkQueue.c ===================================== @@ -4,6 +4,7 @@ * (c) sof, 2002-2003. */ #include "Rts.h" +#include "RtsUtils.h" #include "WorkQueue.h" #include #include ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -1,3 +1,4 @@ + mod184.hs:6:8: warning: [-Wprepositive-qualified-module] Found ‘qualified’ in prepositive position Suggested fix: place ‘qualified’ after the module name instead. ===================================== utils/check-api-annotations/check-api-annotations.cabal ===================================== @@ -24,6 +24,6 @@ Executable check-api-annotations Build-Depends: base >= 4 && < 5, containers, - Cabal >= 3.0 && < 3.4, + Cabal >= 3.0 && < 3.6, directory, ghc ===================================== utils/check-ppr/check-ppr.cabal ===================================== @@ -25,7 +25,7 @@ Executable check-ppr Build-Depends: base >= 4 && < 5, bytestring, containers, - Cabal >= 3.0 && < 3.4, + Cabal >= 3.0 && < 3.6, directory, filepath, ghc ===================================== utils/ghc-cabal/ghc-cabal.cabal ===================================== @@ -21,6 +21,6 @@ Executable ghc-cabal Build-Depends: base >= 3 && < 5, bytestring >= 0.10 && < 0.11, - Cabal >= 3.0 && < 3.4, + Cabal >= 3.0 && < 3.6, directory >= 1.1 && < 1.4, filepath >= 1.2 && < 1.5 ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 +Subproject commit b95f6f29899a8a58223732a6633a47a35b8f1d6a ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ae323deae5b08bbce156cbbd106596affe05d65...b62eed7adfa0022f746afb375d53d918a38e6fde -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ae323deae5b08bbce156cbbd106596affe05d65...b62eed7adfa0022f746afb375d53d918a38e6fde You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 09:35:45 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 10 Sep 2020 05:35:45 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 7 commits: gitlab-ci: Bump Docker images Message-ID: <5f59f371beb73_80b10fbc18c11358112@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 3814414e by Sebastian Graf at 2020-09-10T05:35:28-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - d8bfd785 by Sebastian Graf at 2020-09-10T05:35:28-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - dfb03b7c by GHC GitLab CI at 2020-09-10T05:35:28-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/Data/OrdList.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Utils/Misc.hs - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Target.hs - includes/stg/Ticky.h - testsuite/tests/deSugar/should_compile/ds020.stderr - testsuite/tests/module/all.T - testsuite/tests/module/mod184.stderr - + testsuite/tests/pmcheck/should_compile/T18572.hs - + testsuite/tests/pmcheck/should_compile/T18572.stderr - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/rename/should_compile/T7085.stderr - testsuite/tests/unboxedsums/all.T - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: e1cdfaea745989faa266f09c1d6c4c981aa34dc6 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10: + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: @@ -1082,8 +1082,8 @@ perf-nofib: make install popd rm -Rf tmp - - export BOOT_HC=$(which ghc) - - cabal update; cabal install -w $BOOT_HC regex-compat + - export BOOT_HC=$GHC + - cabal update; cabal install -w "$BOOT_HC" --lib regex-compat - export PATH=$root/bin:$PATH - make -C nofib boot mode=fast -j$CPUS - "make -C nofib EXTRA_RUNTEST_OPTS='-cachegrind +RTS -V0 -RTS' NoFibRuns=1 mode=fast -j$CPUS 2>&1 | tee nofib.log" ===================================== .gitlab/ci.sh ===================================== @@ -152,22 +152,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -204,12 +208,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -233,12 +237,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -279,7 +283,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== compiler/GHC/Data/OrdList.hs ===================================== @@ -5,13 +5,16 @@ -} {-# LANGUAGE DeriveFunctor #-} - {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} -- | Provide trees (of instructions), so that lists of instructions can be -- appended in linear time. module GHC.Data.OrdList ( - OrdList, + OrdList, pattern NilOL, pattern ConsOL, pattern SnocOL, nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL, headOL, mapOL, fromOL, toOL, foldrOL, foldlOL, reverseOL, fromOLReverse, @@ -79,6 +82,50 @@ snocOL as b = Snoc as b consOL a bs = Cons a bs concatOL aas = foldr appOL None aas +pattern NilOL :: OrdList a +pattern NilOL <- (isNilOL -> True) where + NilOL = None + +-- | An unboxed 'Maybe' type with two unboxed fields in the 'Just' case. +-- Useful for defining 'viewCons' and 'viewSnoc' without overhead. +type VMaybe a b = (# (# a, b #) | (# #) #) +pattern VJust :: a -> b -> VMaybe a b +pattern VJust a b = (# (# a, b #) | #) +pattern VNothing :: VMaybe a b +pattern VNothing = (# | (# #) #) +{-# COMPLETE VJust, VNothing #-} + +pattern ConsOL :: a -> OrdList a -> OrdList a +pattern ConsOL x xs <- (viewCons -> VJust x xs) where + ConsOL x xs = consOL x xs +{-# COMPLETE NilOL, ConsOL #-} +viewCons :: OrdList a -> VMaybe a (OrdList a) +viewCons (One a) = VJust a NilOL +viewCons (Cons a as) = VJust a as +viewCons (Snoc as a) = case viewCons as of + VJust a' as' -> VJust a' (Snoc as' a) + VNothing -> VJust a NilOL +viewCons (Two as1 as2) = case viewCons as1 of + VJust a' as1' -> VJust a' (Two as1' as2) + VNothing -> viewCons as2 +viewCons _ = VNothing + +pattern SnocOL :: OrdList a -> a -> OrdList a +pattern SnocOL xs x <- (viewSnoc -> VJust xs x) where + SnocOL xs x = snocOL xs x +{-# COMPLETE NilOL, SnocOL #-} +viewSnoc :: OrdList a -> VMaybe (OrdList a) a +viewSnoc (One a) = VJust NilOL a +viewSnoc (Many (reverse -> a:as)) = VJust (Many (reverse as)) a +viewSnoc (Snoc as a) = VJust as a +viewSnoc (Cons a as) = case viewSnoc as of + VJust as' a' -> VJust (Cons a as') a' + VNothing -> VJust NilOL a +viewSnoc (Two as1 as2) = case viewSnoc as2 of + VJust as2' a' -> VJust (Two as1 as2') a' + VNothing -> viewSnoc as1 +viewSnoc _ = VNothing + headOL None = panic "headOL" headOL (One a) = a headOL (Many as) = head as @@ -189,5 +236,3 @@ strictlyOrdOL (Two a1 a2) (Two b1 b2) = strictlyOrdOL (Two _ _) _ = LT strictlyOrdOL (Many as) (Many bs) = compare as bs strictlyOrdOL (Many _ ) _ = GT - - ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -33,7 +33,7 @@ import {-# SOURCE #-} GHC.HsToCore.Match ( matchWrapper ) import GHC.HsToCore.Monad import GHC.HsToCore.GuardedRHSs import GHC.HsToCore.Utils -import GHC.HsToCore.PmCheck ( addTyCsDs, checkGRHSs ) +import GHC.HsToCore.PmCheck ( addTyCs, covCheckGRHSs ) import GHC.Hs -- lots of things import GHC.Core -- lots of things @@ -152,14 +152,14 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun , fun_matches = matches , fun_ext = co_fn , fun_tick = tick }) - = do { (args, body) <- addTyCsDs FromSource (hsWrapDictBinders co_fn) $ + = do { (args, body) <- addTyCs FromSource (hsWrapDictBinders co_fn) $ -- FromSource might not be accurate (we don't have any -- origin annotations for things in this module), but at -- worst we do superfluous calls to the pattern match -- oracle. - -- addTyCsDs: Add type evidence to the refinement type + -- addTyCs: Add type evidence to the refinement type -- predicate of the coverage checker - -- See Note [Type and Term Equality Propagation] in "GHC.HsToCore.PmCheck" + -- See Note [Long-distance information] in "GHC.HsToCore.PmCheck" matchWrapper (mkPrefixFunRhs (L loc (idName fun))) Nothing matches @@ -185,7 +185,7 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = ty , pat_ticks = (rhs_tick, var_ticks) }) - = do { rhss_deltas <- checkGRHSs PatBindGuards grhss + = do { rhss_deltas <- covCheckGRHSs PatBindGuards grhss ; body_expr <- dsGuarded grhss ty rhss_deltas ; let body' = mkOptTickBox rhs_tick body_expr pat' = decideBangHood dflags pat @@ -201,11 +201,11 @@ dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts , abs_exports = exports , abs_ev_binds = ev_binds , abs_binds = binds, abs_sig = has_sig }) - = do { ds_binds <- addTyCsDs FromSource (listToBag dicts) $ + = do { ds_binds <- addTyCs FromSource (listToBag dicts) $ dsLHsBinds binds - -- addTyCsDs: push type constraints deeper + -- addTyCs: push type constraints deeper -- for inner pattern match check - -- See Check, Note [Type and Term Equality Propagation] + -- See Check, Note [Long-distance information] ; ds_ev_binds <- dsTcEvBinds_s ev_binds ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -31,7 +31,7 @@ import GHC.HsToCore.ListComp import GHC.HsToCore.Utils import GHC.HsToCore.Arrows import GHC.HsToCore.Monad -import GHC.HsToCore.PmCheck ( addTyCsDs, checkGRHSs ) +import GHC.HsToCore.PmCheck ( addTyCs, covCheckGRHSs ) import GHC.Types.Name import GHC.Types.Name.Env import GHC.Core.FamInstEnv( topNormaliseType ) @@ -215,7 +215,7 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss , pat_ext = ty }) body = -- let C x# y# = rhs in body -- ==> case rhs of C x# y# -> body - do { match_deltas <- checkGRHSs PatBindGuards grhss + do { match_deltas <- covCheckGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_deltas ; let upat = unLoc pat eqn = EqnInfo { eqn_pats = [upat], @@ -283,7 +283,7 @@ dsExpr hswrap@(XExpr (WrapExpr (HsWrap co_fn e))) HsConLikeOut _ (RealDataCon dc) -> return $ varToCoreExpr (dataConWrapId dc) XExpr (WrapExpr (HsWrap _ _)) -> pprPanic "dsExpr: HsWrap inside HsWrap" (ppr hswrap) HsPar _ _ -> pprPanic "dsExpr: HsPar inside HsWrap" (ppr hswrap) - _ -> addTyCsDs FromSource (hsWrapDictBinders co_fn) $ + _ -> addTyCs FromSource (hsWrapDictBinders co_fn) $ dsExpr e -- See Note [Detecting forced eta expansion] ; wrap' <- dsHsWrapper co_fn @@ -486,7 +486,7 @@ dsExpr (HsMultiIf res_ty alts) | otherwise = do { let grhss = GRHSs noExtField alts (noLoc emptyLocalBinds) - ; rhss_deltas <- checkGRHSs IfAlt grhss + ; rhss_deltas <- covCheckGRHSs IfAlt grhss ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_deltas ; error_expr <- mkErrorExpr ; extractMatchResult match_result error_expr } @@ -981,7 +981,7 @@ dsDo ctx stmts = do { body <- goL stmts ; rhs' <- dsLExpr rhs ; var <- selectSimpleMatchVarL (xbstc_boundResultMult xbs) pat - ; match <- matchSinglePatVar var (StmtCtxt ctx) pat + ; match <- matchSinglePatVar var Nothing (StmtCtxt ctx) pat (xbstc_boundResultType xbs) (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure ctx pat match (xbstc_failOp xbs) ; dsSyntaxExpr (xbstc_bindOp xbs) [rhs', Lam var match_code] } @@ -1002,7 +1002,7 @@ dsDo ctx stmts ; let match_args (pat, fail_op) (vs,body) = do { var <- selectSimpleMatchVarL Many pat - ; match <- matchSinglePatVar var (StmtCtxt ctx) pat + ; match <- matchSinglePatVar var Nothing (StmtCtxt ctx) pat body_ty (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure ctx pat match fail_op ; return (var:vs, match_code) ===================================== compiler/GHC/HsToCore/GuardedRHSs.hs ===================================== @@ -36,7 +36,7 @@ import Control.Monad ( zipWithM ) import Data.List.NonEmpty ( NonEmpty, toList ) {- - at dsGuarded@ is used for pattern bindings. + at dsGuarded@ is used for GRHSs. It desugars: \begin{verbatim} | g1 -> e1 @@ -44,7 +44,7 @@ It desugars: | gn -> en where binds \end{verbatim} -producing an expression with a runtime error in the corner if +producing an expression with a runtime error in the corner case if necessary. The type argument gives the type of the @ei at . -} @@ -137,8 +137,8 @@ matchGuards (BindStmt _ pat bind_rhs : stmts) ctx deltas rhs rhs_ty = do match_result <- matchGuards stmts ctx deltas rhs rhs_ty core_rhs <- dsLExpr bind_rhs - match_result' <- matchSinglePatVar match_var (StmtCtxt ctx) pat rhs_ty - match_result + match_result' <- matchSinglePatVar match_var (Just core_rhs) (StmtCtxt ctx) + pat rhs_ty match_result pure $ bindNonRec match_var core_rhs <$> match_result' matchGuards (LastStmt {} : _) _ _ _ _ = panic "matchGuards LastStmt" ===================================== compiler/GHC/HsToCore/ListComp.hs ===================================== @@ -617,7 +617,7 @@ dsMcBindStmt :: LPat GhcTc dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts = do { body <- dsMcStmts stmts ; var <- selectSimpleMatchVarL Many pat - ; match <- matchSinglePatVar var (StmtCtxt (DoExpr Nothing)) pat + ; match <- matchSinglePatVar var Nothing (StmtCtxt (DoExpr Nothing)) pat res1_ty (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure (MonadComp :: HsStmtContext GhcRn) pat match fail_op ; dsSyntaxExpr bind_op [rhs', Lam var match_code] } ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -66,7 +66,7 @@ import GHC.Data.FastString import GHC.Types.Unique import GHC.Types.Unique.DFM -import Control.Monad(zipWithM, unless ) +import Control.Monad ( zipWithM, unless, when ) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NEL import qualified Data.Map as Map @@ -769,9 +769,9 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches -- @rhss_deltas@ is a flat list of covered Deltas for each RHS. -- Each Match will split off one Deltas for its RHSs from this. ; matches_deltas <- if isMatchContextPmChecked dflags origin ctxt - then addScrutTmCs mb_scr new_vars $ - -- See Note [Type and Term Equality Propagation] - checkMatches (DsMatchContext ctxt locn) new_vars matches + then addHsScrutTmCs mb_scr new_vars $ + -- See Note [Long-distance information] + covCheckMatches (DsMatchContext ctxt locn) new_vars matches else pure (initDeltasMatches matches) ; eqns_info <- zipWithM mk_eqn_info matches matches_deltas @@ -820,25 +820,24 @@ matchEquations ctxt vars eqns_info rhs_ty ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc ; extractMatchResult match_result fail_expr } -{- -************************************************************************ -* * -\subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern} -* * -************************************************************************ - - at mkSimpleMatch@ is a wrapper for @match@ which deals with the -situation where we want to match a single expression against a single -pattern. It returns an expression. --} - +-- | @matchSimply@ is a wrapper for 'match' which deals with the +-- situation where we want to match a single expression against a single +-- pattern. It returns an expression. matchSimply :: CoreExpr -- ^ Scrutinee -> HsMatchContext GhcRn -- ^ Match kind -> LPat GhcTc -- ^ Pattern it should match -> CoreExpr -- ^ Return this if it matches -> CoreExpr -- ^ Return this if it doesn't -> DsM CoreExpr --- Do not warn about incomplete patterns; see matchSinglePat comments +-- Some reasons 'matchSimply' is not defined using 'matchWrapper' (#18572): +-- * Some call sites like in 'deBindComp' specify a @fail_expr@ that isn't a +-- straight @patError@ +-- * It receives an already desugared 'CoreExpr' for the scrutinee, not an +-- 'HsExpr' like 'matchWrapper' expects +-- * Filling in all the phony fields for the 'MatchGroup' for a single pattern +-- match is awkward +-- * And we still export 'matchSinglePatVar', so not much is gained if we +-- don't also implement it in terms of 'matchWrapper' matchSimply scrut hs_ctx pat result_expr fail_expr = do let match_result = cantFailMatchResult result_expr @@ -858,7 +857,7 @@ matchSinglePat :: CoreExpr -> HsMatchContext GhcRn -> LPat GhcTc matchSinglePat (Var var) ctx pat ty match_result | not (isExternalName (idName var)) - = matchSinglePatVar var ctx pat ty match_result + = matchSinglePatVar var Nothing ctx pat ty match_result matchSinglePat scrut hs_ctx pat ty match_result = do { var <- selectSimpleMatchVarL Many pat @@ -867,22 +866,22 @@ matchSinglePat scrut hs_ctx pat ty match_result -- and to create field selectors. All of which only -- bind unrestricted variables, hence the 'Many' -- above. - ; match_result' <- matchSinglePatVar var hs_ctx pat ty match_result + ; match_result' <- matchSinglePatVar var (Just scrut) hs_ctx pat ty match_result ; return $ bindNonRec var scrut <$> match_result' } matchSinglePatVar :: Id -- See Note [Match Ids] + -> Maybe CoreExpr -- ^ The scrutinee the match id is bound to -> HsMatchContext GhcRn -> LPat GhcTc -> Type -> MatchResult CoreExpr -> DsM (MatchResult CoreExpr) -matchSinglePatVar var ctx pat ty match_result +matchSinglePatVar var mb_scrut ctx pat ty match_result = ASSERT2( isInternalName (idName var), ppr var ) do { dflags <- getDynFlags ; locn <- getSrcSpanDs - -- Pattern match check warnings - ; if isMatchContextPmChecked dflags FromSource ctx - then checkSingle dflags (DsMatchContext ctx locn) var (unLoc pat) - else pure () + ; when (isMatchContextPmChecked dflags FromSource ctx) $ + addCoreScrutTmCs mb_scrut [var] $ + covCheckPatBind (DsMatchContext ctx locn) var (unLoc pat) ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] , eqn_orig = FromSource ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -29,6 +29,7 @@ matchSimply matchSinglePatVar :: Id + -> Maybe CoreExpr -> HsMatchContext GhcRn -> LPat GhcTc -> Type ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -1,24 +1,51 @@ -{- -Author: George Karachalias - -Pattern Matching Coverage Checking. --} - -{-# LANGUAGE CPP #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} - +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | This module coverage checks pattern matches. It finds +-- +-- * Uncovered patterns, certifying non-exhaustivity +-- * Redundant equations +-- * Equations with an inaccessible right-hand-side +-- +-- The algorithm is based on the paper +-- [Lower Your Guards: A Compositional Pattern-Match Coverage Checker"](https://dl.acm.org/doi/abs/10.1145/3408989) +-- +-- There is an overview Figure 2 in there that's probably helpful. +-- Here is an overview of how it's implemented, which follows the structure of +-- the entry points such as 'covCheckMatches': +-- +-- 1. Desugar source syntax (like 'LMatch') to guard tree variants (like +-- 'GrdMatch'), with one of the desugaring functions (like 'desugarMatch'). +-- Follows Section 3.1 in the paper. +-- 2. Coverage check guard trees (with a function like 'checkMatch') to get a +-- 'CheckResult', containing +-- a. The set of uncovered values, 'cr_uncov' +-- b. And an annotated tree variant (like 'AnnMatch') that captures +-- redundancy and inaccessibility information as 'RedSets' annotations +-- Basically the UA function from Section 5.1. The Normalised Refinement Types +-- Nabla are modeled as 'Deltas' and checked in "GHC.HsToCore.PmCheck.Oracle". +-- 3. Collect redundancy information into a 'CIRB' with a function such +-- as 'cirbsMatch'. Follows the R function from Figure 6 of the paper. +-- 4. Format and report uncovered patterns and redundant equations ('CIRB') +-- with 'formatReportWarnings'. Basically job of the G function, plus proper +-- pretty printing of the warnings (Section 5.4 of the paper). +-- 5. Return 'Deltas' reaching syntactic sub-components for +-- Note [Long-distance information]. Collected by functions such as +-- 'ldiMatch'. See Section 4.1 of the paper. module GHC.HsToCore.PmCheck ( -- Checking and printing - checkSingle, checkMatches, checkGRHSs, + covCheckPatBind, covCheckMatches, covCheckGRHSs, isMatchContextPmChecked, - -- See Note [Type and Term Equality Propagation] - addTyCsDs, addScrutTmCs + -- See Note [Long-distance information] + addTyCs, addCoreScrutTmCs, addHsScrutTmCs ) where #include "HsVersions.h" @@ -37,7 +64,6 @@ import GHC.Tc.Utils.Zonk (shortCutLit) import GHC.Types.Id import GHC.Core.ConLike import GHC.Types.Name -import GHC.Tc.Instance.Family import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Misc @@ -62,35 +88,148 @@ import GHC.Core.Type import GHC.HsToCore.Utils (isTrueLHsExpr) import GHC.Data.Maybe import qualified GHC.LanguageExtensions as LangExt -import GHC.Utils.Monad (concatMapM) +import GHC.Utils.Monad (concatMapM, mapMaybeM) import Control.Monad (when, forM_, zipWithM) import Data.List (elemIndex) import qualified Data.Semigroup as Semi -import Data.List.NonEmpty (NonEmpty(..)) +import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE +import Data.Coerce -{- -This module checks pattern matches for: -\begin{enumerate} - \item Equations that are redundant - \item Equations with inaccessible right-hand-side - \item Exhaustiveness -\end{enumerate} +-- +-- * Exported entry points to the checker +-- -The algorithm is based on the paper: +-- | A non-empty delta that is initialised from the ambient refinement type +-- capturing long-distance information, or the trivially habitable 'Deltas' if +-- the former is uninhabited. +-- See Note [Recovering from unsatisfiable pattern-matching constraints]. +getLdiDeltas :: DsM Deltas +getLdiDeltas = do + deltas <- getPmDeltas + isInhabited deltas >>= \case + True -> pure deltas + False -> pure initDeltas + +-- | Check a pattern binding (let, where) for exhaustiveness. +covCheckPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () +-- See Note [covCheckPatBind only checks PatBindRhs] +covCheckPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do + missing <- getLdiDeltas + pat_bind <- desugarPatBind loc var p + tracePm "covCheckPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) + result <- unCA (checkPatBind pat_bind) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsPatBind ctxt [var] result +covCheckPatBind _ _ _ = pure () + +-- | Exhaustive for guard matches, is used for guards in pattern bindings and +-- in @MultiIf@ expressions. Returns the 'Deltas' covered by the RHSs. +covCheckGRHSs + :: HsMatchContext GhcRn -- ^ Match context, for warning messages + -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check + -> DsM (NonEmpty Deltas) -- ^ Covered 'Deltas' for each RHS, for long + -- distance info +covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do + let combined_loc = foldl1 combineSrcSpans (map getLoc grhss) + ctxt = DsMatchContext hs_ctxt combined_loc + matches <- desugarGRHSs combined_loc empty guards + missing <- getLdiDeltas + tracePm "covCheckGRHSs" (hang (vcat [ppr ctxt + , text "Guards:"]) + 2 + (pprGRHSs hs_ctxt guards $$ ppr missing)) + result <- unCA (checkGRHSs matches) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsGRHSs ctxt [] result + return (ldiGRHS <$> cr_ret result) + +-- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each +-- with a 'Pat' and one or more 'GRHSs': +-- +-- @ +-- f x y | x == y = 1 -- match on x and y with two guarded RHSs +-- | otherwise = 2 +-- f _ _ = 3 -- clause with a single, un-guarded RHS +-- @ +-- +-- Returns one non-empty 'Deltas' for 1.) each pattern of a 'Match' and 2.) +-- each of a 'Match'es 'GRHS' for Note [Long-distance information]. +-- +-- Special case: When there are /no matches/, then the functionassumes it +-- checks and @-XEmptyCase@ with only a single match variable. +-- See Note [Checking EmptyCase]. +covCheckMatches + :: DsMatchContext -- ^ Match context, for warnings messages + -> [Id] -- ^ Match variables, i.e. x and y above + -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches + -> DsM [(Deltas, NonEmpty Deltas)] -- ^ One covered 'Deltas' per Match and + -- GRHS, for long distance info. +covCheckMatches ctxt vars matches = do + -- We have to force @missing@ before printing out the trace message, + -- otherwise we get interleaved output from the solver. This function + -- should be strict in @missing@ anyway! + !missing <- getLdiDeltas + tracePm "covCheckMatches {" $ + hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) + 2 + (vcat (map ppr matches) $$ ppr missing) + case NE.nonEmpty matches of + Nothing -> do + -- This must be an -XEmptyCase. See Note [Checking EmptyCase] + let var = only vars + empty_case <- desugarEmptyCase var + result <- unCA (checkEmptyCase empty_case) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsEmptyCase ctxt vars result + return [] + Just matches -> do + matches <- desugarMatches vars matches + result <- unCA (checkMatchGroup matches) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsMatchGroup ctxt vars result + return (NE.toList (ldiMatchGroup (cr_ret result))) + +{- Note [covCheckPatBind only checks PatBindRhs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + at covCheckPatBind@'s sole purpose is to check vanilla pattern bindings, like + at x :: Int; Just x = e@, which is in a @PatBindRhs@ context. +But its caller is also called for individual pattern guards in a @StmtCtxt at . +For example, both pattern guards in @f x y | True <- x, False <- y = ...@ will +go through this function. It makes no sense to do coverage checking there: + * Pattern guards may well fail. Fall-through is not an unrecoverable panic, + but rather behavior the programmer expects, so inexhaustivity should not be + reported. + * Redundancy is already reported for the whole GRHS via one of the other + exported coverage checking functions. Also reporting individual redundant + guards is... redundant. See #17646. +Note that we can't just omit checking of @StmtCtxt@ altogether (by adjusting +'isMatchContextPmChecked'), because that affects the other checking functions, +too. + +Note [Checking EmptyCase] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-XEmptyCase is useful for matching on empty data types like 'Void'. For example, +the following is a complete match: - "GADTs Meet Their Match: - Pattern-matching Warnings That Account for GADTs, Guards, and Laziness" + f :: Void -> () + f x = case x of {} - https://www.microsoft.com/en-us/research/wp-content/uploads/2016/08/gadtpm-acm.pdf +Really, -XEmptyCase is the only way to write a program that at the same time is +safe (@f _ = error "boom"@ is not because of ⊥), doesn't trigger a warning +(@f !_ = error "inaccessible" has inaccessible RHS) and doesn't turn an +exception into divergence (@f x = f x@). -%************************************************************************ -%* * - Pattern Match Check Types -%* * -%************************************************************************ +Semantically, unlike every other case expression, -XEmptyCase is strict in its +match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the +initial Delta and check if there are any values left to match on. -} +-- +-- * Guard language +-- + -- | A very simple language for pattern guards. Let bindings, bang patterns, -- and matching variables against flat constructor patterns. data PmGrd @@ -106,9 +245,9 @@ data PmGrd } -- | @PmBang x@ corresponds to a @seq x True@ guard. - -- If the extra SrcInfo is present, the bang guard came from a source - -- bang pattern, in which case we might want to report it as redundant, - -- see Note [Dead bang patterns]. + -- If the extra 'SrcInfo' is present, the bang guard came from a source + -- bang pattern, in which case we might want to report it as redundant. + -- See Note [Dead bang patterns]. | PmBang { pm_id :: !Id, pm_loc :: !(Maybe SrcInfo) @@ -144,24 +283,115 @@ instance Monoid Precision where mempty = Precise mappend = (Semi.<>) --- | Means by which we identify source location for later pretty-printing --- in a warning message. 'SDoc' for the equation to show, 'Located' for --- the location. +-- +-- * Guard tree language +-- + +-- | Means by which we identify a source construct for later pretty-printing in +-- a warning message. 'SDoc' for the equation to show, 'Located' for the +-- location. type SrcInfo = Located SDoc --- | A representation of the desugaring to 'PmGrd's of all clauses of a --- function definition/pattern match/etc. -data GrdTree - = Rhs !SrcInfo - | Guard !PmGrd !GrdTree - -- ^ @Guard grd t@ will try to match @grd@ and on success continue to match - -- @t at . Falls through if either match fails. Models left-to-right semantics - -- of pattern matching. - | Sequence ![GrdTree] - -- ^ @Sequence (t:ts)@ matches against @t@, and then matches all - -- fallen-through values against @Sequence ts at . Models top-to-bottom semantics - -- of pattern matching. - -- @Sequence []@ always fails; it is useful for Note [Checking EmptyCase]. +-- | Redundancy sets, used to determine redundancy of RHSs and bang patterns +-- (later digested into a 'CIRB'). +data RedSets + = RedSets + { rs_cov :: !Deltas + -- ^ The /Covered/ set; the set of values reaching a particular program + -- point. + , rs_div :: !Deltas + -- ^ The /Diverging/ set; empty if no match can lead to divergence. + -- If it wasn't empty, we have to turn redundancy warnings into + -- inaccessibility warnings for any subclauses. + , rs_bangs :: !(OrdList (Deltas, SrcInfo)) + -- ^ If any of the 'Deltas' is empty, the corresponding 'SrcInfo' pin-points + -- a bang pattern in source that is redundant. See Note [Dead bang patterns]. + } + +-- The following two type synonyms instantiate our tree structures to guard +-- trees and annotated trees, respectively, by giving the types to attach as +-- payload. + +-- | Used as tree payload pre-checking. The LYG guards to check. +type Pre = [PmGrd] + +-- | Used as tree payload post-checking. The redundancy info we elaborated. +type Post = RedSets + +-- | A guard tree denoting 'MatchGroup'. +newtype PmMatchGroup p = PmMatchGroup (NonEmpty (PmMatch p)) + +-- | A guard tree denoting 'Match': A payload describing the pats and a bunch of +-- GRHS. +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(NonEmpty (PmGRHS p)) } + +-- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' +-- useful for printing out in warnings messages. +data PmGRHS p = PmGRHS { pg_grds :: !p, pg_rhs :: !SrcInfo } + +-- | A guard tree denoting an -XEmptyCase. +newtype PmEmptyCase = PmEmptyCase { pe_var :: Id } + +-- | A guard tree denoting a pattern binding. +newtype PmPatBind p = + -- just reuse GrdGRHS and pretend its @SrcInfo@ is info on the /pattern/, + -- rather than on the pattern bindings. + PmPatBind (PmGRHS p) + +emptyRedSets :: RedSets +-- Semigroup instance would be misleading! +emptyRedSets = RedSets mempty mempty mempty + +pprSrcInfo :: SrcInfo -> SDoc +pprSrcInfo (L (RealSrcSpan rss _) _) = ppr (srcSpanStartLine rss) +pprSrcInfo (L s _) = ppr s + +-- | Format LYG guards as @| True <- x, let x = 42, !z@ +pprLygGuards :: [PmGrd] -> SDoc +pprLygGuards [] = empty +pprLygGuards (g:gs) = fsep (char '|' <+> ppr g : map ((comma <+>) . ppr) gs) + +-- | Format a LYG sequence (e.g. 'Match'es of a 'MatchGroup' or 'GRHSs') as +-- @{ ; ...; }@ +pprLygSequence :: Outputable a => NonEmpty a -> SDoc +pprLygSequence (NE.toList -> as) = + braces (space <> fsep (punctuate semi (map ppr as)) <> space) + +instance Outputable (PmMatchGroup Pre) where + ppr (PmMatchGroup matches) = pprLygSequence matches + +instance Outputable (PmMatch Pre) where + ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = + pprLygGuards grds <+> ppr grhss + +instance Outputable (PmGRHS Pre) where + ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = + pprLygGuards grds <+> text "->" <+> pprSrcInfo rhs + +instance Outputable (PmPatBind Pre) where + ppr (PmPatBind PmGRHS { pg_grds = grds, pg_rhs = bind }) = + ppr bind <+> pprLygGuards grds <+> text "=" <+> text "..." + +instance Outputable PmEmptyCase where + ppr (PmEmptyCase { pe_var = var }) = + text " ppr var <> text ">" + +pprRedSets :: RedSets -> SDoc +-- It's useful to change this definition for different verbosity levels in +-- printf-debugging +pprRedSets RedSets { rs_cov = _cov, rs_div = _div, rs_bangs = _bangs } + = empty + +instance Outputable (PmMatchGroup Post) where + ppr (PmMatchGroup matches) = pprLygSequence matches + +instance Outputable (PmMatch Post) where + ppr (PmMatch { pm_pats = red, pm_grhss = grhss }) = + pprRedSets red <+> ppr grhss + +instance Outputable (PmGRHS Post) where + ppr (PmGRHS { pg_grds = red, pg_rhs = rhs }) = + pprRedSets red <+> text "->" <+> pprSrcInfo rhs {- Note [Dead bang patterns] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -178,7 +408,7 @@ that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs; see below. We can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable -where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is +where the PmBang appears in 'checkGrd'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. @@ -197,235 +427,9 @@ it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. -} --- | The digest of 'checkGrdTree', representing the annotated pattern-match --- tree. 'extractRedundancyInfo' can figure out redundant and proper --- inaccessible RHSs from this, as well as dead bangs. -data AnnotatedTree - = AccessibleRhs !Deltas !SrcInfo - -- ^ A RHS deemed accessible. The 'Deltas' is the (non-empty) set of covered - -- values. - | InaccessibleRhs !SrcInfo - -- ^ A RHS deemed inaccessible; it covers no value. - | MayDiverge !AnnotatedTree - -- ^ Asserts that the tree may force diverging values, so not all of its - -- clauses can be redundant. - | SequenceAnn !Deltas ![AnnotatedTree] - -- ^ @SequenceAnn inc ts@ mirrors @'Sequence' ts@ for preserving the - -- skeleton of a 'GrdTree's @ts at . It also carries the set of incoming values - -- @inc at . - | RedundantSrcBang !SrcInfo !AnnotatedTree - -- ^ For tracking redundant bangs. See Note [Dead bang patterns] - -pprSrcInfo :: SrcInfo -> SDoc -pprSrcInfo (L (RealSrcSpan rss _) _) = ppr (srcSpanStartLine rss) -pprSrcInfo (L s _) = ppr s - -instance Outputable GrdTree where - ppr (Rhs info) = text "->" <+> pprSrcInfo info - -- Format guards as "| True <- x, let x = 42, !z" - ppr g at Guard{} = fsep (prefix (map ppr grds)) <+> ppr t - where - (t, grds) = collect_grds g - collect_grds (Guard grd t) = (grd :) <$> collect_grds t - collect_grds t = (t, []) - prefix [] = [] - prefix (s:sdocs) = char '|' <+> s : map (comma <+>) sdocs - ppr (Sequence []) = text "" - ppr (Sequence ts) = braces (space <> fsep (punctuate semi (map ppr ts)) <> space) - -instance Outputable AnnotatedTree where - ppr (AccessibleRhs _delta info) = parens (ppr _delta) <+> pprSrcInfo info - ppr (InaccessibleRhs info) = text "inaccessible" <+> pprSrcInfo info - ppr (MayDiverge t) = text "div" <+> ppr t - ppr (SequenceAnn _ []) = text "" - ppr (SequenceAnn _ ts) = braces (space <> fsep (punctuate semi (map ppr ts)) <> space) - ppr (RedundantSrcBang l t) = text "redundant bang" <+> pprSrcInfo l <+> ppr t - --- | Lift 'addPmCts' over 'Deltas'. -addPmCtsDeltas :: Deltas -> PmCts -> DsM Deltas -addPmCtsDeltas deltas cts = liftDeltasM (\d -> addPmCts d cts) deltas - --- | 'addPmCtsDeltas' a single 'PmCt'. -addPmCtDeltas :: Deltas -> PmCt -> DsM Deltas -addPmCtDeltas deltas ct = addPmCtsDeltas deltas (unitBag ct) - --- | Test if any of the 'Delta's is inhabited. Currently this is pure, because --- we preserve the invariant that there are no uninhabited 'Delta's. But that --- could change in the future, for example by implementing this function in --- terms of @notNull <$> provideEvidence 1 ds at . -isInhabited :: Deltas -> DsM Bool -isInhabited (MkDeltas ds) = pure (not (null ds)) - --- | Pattern-match check result -data CheckResult - = CheckResult - { cr_clauses :: !AnnotatedTree - -- ^ Captures redundancy info for each clause in the original program. - -- (for -Woverlapping-patterns) - , cr_uncov :: !Deltas - -- ^ The set of uncovered values falling out at the bottom. - -- (for -Wincomplete-patterns) - , cr_approx :: !Precision - -- ^ A flag saying whether we ran into the 'maxPmCheckModels' limit for the - -- purpose of suggesting to crank it up in the warning message - } - -instance Outputable CheckResult where - ppr (CheckResult c unc pc) - = text "CheckResult" <+> ppr_precision pc <+> braces (fsep - [ field "clauses" c <> comma - , field "uncov" unc]) - where - ppr_precision Precise = empty - ppr_precision Approximate = text "(Approximate)" - field name value = text name <+> equals <+> ppr value - -{- -%************************************************************************ -%* * - Entry points to the checker: checkSingle and checkMatches -%* * -%************************************************************************ --} - --- | Check a single pattern binding (let) for exhaustiveness. -checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () -checkSingle dflags ctxt@(DsMatchContext kind locn) var p = do - tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - -- We only ever need to run this in a context where we need exhaustivity - -- warnings (so not in pattern guards or comprehensions, for example, because - -- they are perfectly fine to fail). - -- Omitting checking this flag emits redundancy warnings twice in obscure - -- cases like #17646. - when (exhaustive dflags kind) $ do - -- TODO: This could probably call checkMatches, like checkGRHSs. - missing <- getPmDeltas - tracePm "checkSingle: missing" (ppr missing) - fam_insts <- dsGetFamInstEnvs - grd_tree <- mkGrdTreeRhs (L locn $ ppr p) <$> translatePat fam_insts var p - res <- checkGrdTree grd_tree missing - dsPmWarn dflags ctxt [var] res - --- | Exhaustive for guard matches, is used for guards in pattern bindings and --- in @MultiIf@ expressions. Returns the 'Deltas' covered by the RHSs. -checkGRHSs - :: HsMatchContext GhcRn -- ^ Match context, for warning messages - -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check - -> DsM (NonEmpty Deltas) -- ^ Covered 'Deltas' for each RHS, for long - -- distance info -checkGRHSs hs_ctx guards@(GRHSs _ grhss _) = do - let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) - dsMatchContext = DsMatchContext hs_ctx combinedLoc - match = L combinedLoc $ - Match { m_ext = noExtField - , m_ctxt = hs_ctx - , m_pats = [] - , m_grhss = guards } - [(_, deltas)] <- checkMatches dsMatchContext [] [match] - pure deltas - --- | Check a list of syntactic /match/es (part of case, functions, etc.), each --- with a /pat/ and one or more /grhss/: -- --- @ --- f x y | x == y = 1 -- match on x and y with two guarded RHSs --- | otherwise = 2 --- f _ _ = 3 -- clause with a single, un-guarded RHS --- @ +-- * Desugaring source syntax to guard trees -- --- Returns one 'Deltas' for each GRHS, representing its covered values, or the --- incoming uncovered 'Deltas' (from 'getPmDeltas') if the GRHS is inaccessible. --- Since there is at least one /grhs/ per /match/, the list of 'Deltas' is at --- least as long as the list of matches. -checkMatches - :: DsMatchContext -- ^ Match context, for warnings messages - -> [Id] -- ^ Match variables, i.e. x and y above - -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches - -> DsM [(Deltas, NonEmpty Deltas)] -- ^ One covered 'Deltas' per RHS, for long - -- distance info. -checkMatches ctxt vars matches = do - tracePm "checkMatches" (hang (vcat [ppr ctxt - , ppr vars - , text "Matches:"]) - 2 - (vcat (map ppr matches))) - - init_deltas <- getPmDeltas - missing <- case matches of - -- This must be an -XEmptyCase. See Note [Checking EmptyCase] - [] | [var] <- vars -> addPmCtDeltas init_deltas (PmNotBotCt var) - _ -> pure init_deltas - fam_insts <- dsGetFamInstEnvs - grd_tree <- translateMatches fam_insts vars matches - res <- checkGrdTree grd_tree missing - - dflags <- getDynFlags - dsPmWarn dflags ctxt vars res - - return (extractRhsDeltas (cr_clauses res)) - --- | Extract the 'Deltas' reaching the RHSs of the 'AnnotatedTree' for a match --- group. --- For 'AccessibleRhs's, this is stored in the tree node, whereas --- 'InaccessibleRhs's fall back to the supplied original 'Deltas'. --- See @Note [Recovering from unsatisfiable pattern-matching constraints]@. -extractRhsDeltas :: AnnotatedTree -> [(Deltas, NonEmpty Deltas)] -extractRhsDeltas = go_matches - where - go_matches :: AnnotatedTree -> [(Deltas, NonEmpty Deltas)] - go_matches (SequenceAnn def ts) = map (go_match def) ts -- -XEmptyCase handled here! - go_matches t = pprPanic "extractRhsDeltas.go_matches" (text "Matches must start with SequenceAnn. But was" $$ ppr t) - - go_match :: Deltas -> AnnotatedTree -> (Deltas, NonEmpty Deltas) - -- There is no -XEmptyCase at this level, only at the Matches level. So @ts@ - -- is non-empty! - go_match def (SequenceAnn pat ts) = (pat, foldMap1 (text "go_match: empty SequenceAnn") (go_grhss def) ts) - go_match def (MayDiverge t) = go_match def t - go_match def (RedundantSrcBang _ t) = go_match def t - -- Even if there's only a single GRHS, we wrap it in a SequenceAnn for the - -- Deltas covered by the pattern. So the remaining cases are impossible! - go_match _ t = pprPanic "extractRhsDeltas.go_match" (text "Single GRHS must be wrapped in SequenceAnn. But got " $$ ppr t) - - go_grhss :: Deltas -> AnnotatedTree -> NonEmpty Deltas - -- There is no -XEmptyCase at this level, only at the Matches level. So @ts@ - -- is non-empty! - go_grhss def (SequenceAnn _ ts) = foldMap1 (text "go_grhss: empty SequenceAnn") (go_grhss def) ts - go_grhss def (MayDiverge t) = go_grhss def t - go_grhss def (RedundantSrcBang _ t) = go_grhss def t - go_grhss _ (AccessibleRhs deltas _) = deltas :| [] - go_grhss def (InaccessibleRhs _) = def :| [] - - foldMap1 msg _ [] = pprPanic "extractRhsDeltas.foldMap1" msg - foldMap1 _ f (x:xs) = foldl' (\acc x -> acc Semi.<> f x) (f x) xs - -{- Note [Checking EmptyCase] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --XEmptyCase is useful for matching on empty data types like 'Void'. For example, -the following is a complete match: - - f :: Void -> () - f x = case x of {} - -Really, -XEmptyCase is the only way to write a program that at the same time is -safe (@f _ = error "boom"@ is not because of ⊥), doesn't trigger a warning -(@f !_ = error "inaccessible" has inaccessible RHS) and doesn't turn an -exception into divergence (@f x = f x@). - -Semantically, unlike every other case expression, -XEmptyCase is strict in its -match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the -initial Delta and check if there are any values left to match on. --} - -{- -%************************************************************************ -%* * - Transform source syntax to *our* syntax -%* * -%************************************************************************ --} - --- ----------------------------------------------------------------------- --- * Utilities -- | Smart constructor that eliminates trivial lets mkPmLetVar :: Id -> Id -> GrdVec @@ -458,7 +462,7 @@ mkListGrds a ((x, head_grds):xs) = do -- | Create a 'GrdVec' refining a match variable to a 'PmLit'. mkPmLitGrds :: Id -> PmLit -> DsM GrdVec mkPmLitGrds x (PmLit _ (PmLitString s)) = do - -- We translate String literals to list literals for better overlap reasoning. + -- We desugar String literals to list literals for better overlap reasoning. -- It's a little unfortunate we do this here rather than in -- 'GHC.HsToCore.PmCheck.Oracle.trySolve' and -- 'GHC.HsToCore.PmCheck.Oracle.addRefutableAltCon', but it's so much simpler @@ -476,37 +480,34 @@ mkPmLitGrds x lit = do , pm_con_args = [] } pure [grd] --- ----------------------------------------------------------------------- --- * Transform (Pat Id) into GrdVec - --- | @translatePat _ x pat@ transforms @pat@ into a 'GrdVec', where +-- | @desugarPat _ x pat@ transforms @pat@ into a 'GrdVec', where -- the variable representing the match is @x at . -translatePat :: FamInstEnvs -> Id -> Pat GhcTc -> DsM GrdVec -translatePat fam_insts x pat = case pat of +desugarPat :: Id -> Pat GhcTc -> DsM GrdVec +desugarPat x pat = case pat of WildPat _ty -> pure [] VarPat _ y -> pure (mkPmLetVar (unLoc y) x) - ParPat _ p -> translateLPat fam_insts x p + ParPat _ p -> desugarLPat x p LazyPat _ _ -> pure [] -- like a wildcard BangPat _ p@(L l p') -> -- Add the bang in front of the list, because it will happen before any -- nested stuff. - (PmBang x pm_loc :) <$> translateLPat fam_insts x p - where pm_loc = Just (L l (ppr p')) + (PmBang x pm_loc :) <$> desugarLPat x p + where pm_loc = Just (L l (ppr p')) - -- (x at pat) ==> Translate pat with x as match var and handle impedance + -- (x at pat) ==> Desugar pat with x as match var and handle impedance -- mismatch with incoming match var - AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> translateLPat fam_insts y p + AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> desugarLPat y p - SigPat _ p _ty -> translateLPat fam_insts x p + SigPat _ p _ty -> desugarLPat x p - -- See Note [Translate CoPats] + -- See Note [Desugar CoPats] -- Generally the translation is -- pat |> co ===> let y = x |> co, pat <- y where y is a match var of pat XPat (CoPat wrapper p _ty) - | isIdHsWrapper wrapper -> translatePat fam_insts x p - | WpCast co <- wrapper, isReflexiveCo co -> translatePat fam_insts x p + | isIdHsWrapper wrapper -> desugarPat x p + | WpCast co <- wrapper, isReflexiveCo co -> desugarPat x p | otherwise -> do - (y, grds) <- translatePatV fam_insts p + (y, grds) <- desugarPatV p wrap_rhs_y <- dsHsWrapper wrapper pure (PmLet y (wrap_rhs_y (Var x)) : grds) @@ -521,13 +522,13 @@ translatePat fam_insts x pat = case pat of -- (fun -> pat) ===> let y = fun x, pat <- y where y is a match var of pat ViewPat _arg_ty lexpr pat -> do - (y, grds) <- translateLPatV fam_insts pat + (y, grds) <- desugarLPatV pat fun <- dsLExpr lexpr pure $ PmLet y (App fun (Var x)) : grds -- list ListPat (ListPatTc _elem_ty Nothing) ps -> - translateListPat fam_insts x ps + desugarListPat x ps -- overloaded list ListPat (ListPatTc elem_ty (Just (pat_ty, to_list))) pats -> do @@ -535,11 +536,11 @@ translatePat fam_insts x pat = case pat of case splitListTyConApp_maybe pat_ty of Just _e_ty | not (xopt LangExt.RebindableSyntax dflags) - -- Just translate it as a regular ListPat - -> translateListPat fam_insts x pats + -- Just desugar it as a regular ListPat + -> desugarListPat x pats _ -> do y <- mkPmId (mkListTy elem_ty) - grds <- translateListPat fam_insts y pats + grds <- desugarListPat y pats rhs_y <- dsSyntaxExpr to_list [Var x] pure $ PmLet y rhs_y : grds @@ -565,7 +566,7 @@ translatePat fam_insts x pat = case pat of , cpt_dicts = dicts } } -> do - translateConPatOut fam_insts x con arg_tys ex_tvs dicts ps + desugarConPatOut x con arg_tys ex_tvs dicts ps NPat ty (L _ olit) mb_neg _ -> do -- See Note [Literal short cut] in "GHC.HsToCore.Match.Literal" @@ -594,46 +595,44 @@ translatePat fam_insts x pat = case pat of mkPmLitGrds x lit TuplePat _tys pats boxity -> do - (vars, grdss) <- mapAndUnzipM (translateLPatV fam_insts) pats + (vars, grdss) <- mapAndUnzipM desugarLPatV pats let tuple_con = tupleDataCon boxity (length vars) pure $ vanillaConGrd x tuple_con vars : concat grdss SumPat _ty p alt arity -> do - (y, grds) <- translateLPatV fam_insts p + (y, grds) <- desugarLPatV p let sum_con = sumDataCon alt arity -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon pure $ vanillaConGrd x sum_con [y] : grds - -- -------------------------------------------------------------------------- - -- Not supposed to happen - SplicePat {} -> panic "Check.translatePat: SplicePat" + SplicePat {} -> panic "Check.desugarPat: SplicePat" --- | 'translatePat', but also select and return a new match var. -translatePatV :: FamInstEnvs -> Pat GhcTc -> DsM (Id, GrdVec) -translatePatV fam_insts pat = do +-- | 'desugarPat', but also select and return a new match var. +desugarPatV :: Pat GhcTc -> DsM (Id, GrdVec) +desugarPatV pat = do x <- selectMatchVar Many pat - grds <- translatePat fam_insts x pat + grds <- desugarPat x pat pure (x, grds) -translateLPat :: FamInstEnvs -> Id -> LPat GhcTc -> DsM GrdVec -translateLPat fam_insts x = translatePat fam_insts x . unLoc +desugarLPat :: Id -> LPat GhcTc -> DsM GrdVec +desugarLPat x = desugarPat x . unLoc --- | 'translateLPat', but also select and return a new match var. -translateLPatV :: FamInstEnvs -> LPat GhcTc -> DsM (Id, GrdVec) -translateLPatV fam_insts = translatePatV fam_insts . unLoc +-- | 'desugarLPat', but also select and return a new match var. +desugarLPatV :: LPat GhcTc -> DsM (Id, GrdVec) +desugarLPatV = desugarPatV . unLoc --- | @translateListPat _ x [p1, ..., pn]@ is basically --- @translateConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever +-- | @desugarListPat _ x [p1, ..., pn]@ is basically +-- @desugarConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever -- constructing the 'ConPatOut's. -translateListPat :: FamInstEnvs -> Id -> [LPat GhcTc] -> DsM GrdVec -translateListPat fam_insts x pats = do - vars_and_grdss <- traverse (translateLPatV fam_insts) pats +desugarListPat :: Id -> [LPat GhcTc] -> DsM GrdVec +desugarListPat x pats = do + vars_and_grdss <- traverse desugarLPatV pats mkListGrds x vars_and_grdss --- | Translate a constructor pattern -translateConPatOut :: FamInstEnvs -> Id -> ConLike -> [Type] -> [TyVar] +-- | Desugar a constructor pattern +desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar] -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdVec -translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case +desugarConPatOut x con univ_tys ex_tvs dicts = \case PrefixCon ps -> go_field_pats (zip [0..] ps) InfixCon p1 p2 -> go_field_pats (zip [0..] [p1,p2]) RecCon (HsRecFields fs _) -> go_field_pats (rec_field_ps fs) @@ -647,7 +646,7 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case where tagged_pat f = (lbl_to_index (getName (hsRecFieldId f)), hsRecFieldArg f) -- Unfortunately the label info is empty when the DataCon wasn't defined - -- with record field labels, hence we translate to field index. + -- with record field labels, hence we desugar to field index. orig_lbls = map flSelector $ conLikeFieldLabels con lbl_to_index lbl = expectJust "lbl_to_index" $ elemIndex lbl orig_lbls @@ -658,10 +657,10 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case -- the first field of @tagged_pats at . -- See Note [Field match order for RecCon] - -- Translate the mentioned field patterns. We're doing this first to get + -- Desugar the mentioned field patterns. We're doing this first to get -- the Ids for pm_con_args. let trans_pat (n, pat) = do - (var, pvec) <- translateLPatV fam_insts pat + (var, pvec) <- desugarLPatV pat pure ((n, var), pvec) (tagged_vars, arg_grdss) <- mapAndUnzipM trans_pat tagged_pats @@ -687,77 +686,81 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case -- 1. 2. 3. pure (con_grd : bang_grds ++ arg_grds) --- | Translate a the 'Match'es of a 'MatchGroup' -translateMatches :: FamInstEnvs -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] - -> DsM GrdTree -translateMatches fam_insts vars matches = - -- It's important that we wrap a 'Sequence' even if it only wraps a singleton. - -- 'extractRhsDeltas' needs this to recover 'MatchGroup' structure. - Sequence <$> traverse (translateMatch fam_insts vars) matches - --- Translate a single match -translateMatch :: FamInstEnvs -> [Id] -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM GrdTree -translateMatch fam_insts vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do - pats' <- concat <$> zipWithM (translateLPat fam_insts) vars pats - grhss' <- translateGRHSs fam_insts match_loc (sep (map ppr pats)) grhss - -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr grhss']) - return (foldr Guard grhss' pats') - -mkGrdTreeRhs :: Located SDoc -> GrdVec -> GrdTree -mkGrdTreeRhs sdoc = foldr Guard (Rhs sdoc) - -translateGRHSs :: FamInstEnvs -> SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM GrdTree -translateGRHSs fam_insts match_loc pp_pats grhss = - -- It's important that we wrap a 'Sequence' even if it only wraps a singleton. - -- 'extractRhsDeltas' needs this to recover 'GRHSs' structure. - Sequence <$> traverse (translateLGRHS fam_insts match_loc pp_pats) (grhssGRHSs grhss) - --- | Translate a guarded right-hand side to a single 'GrdTree' -translateLGRHS :: FamInstEnvs -> SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM GrdTree -translateLGRHS fam_insts match_loc pp_pats (L _loc (GRHS _ gs _)) = - -- _loc points to the match separator (ie =, ->) that comes after the guards.. - mkGrdTreeRhs loc_sdoc <$> concatMapM (translateGuard fam_insts . unLoc) gs - where - loc_sdoc - -- pp_pats is the space-separated pattern of the current Match this - -- GRHS belongs to, so the @A B x@ part in @A B x | 0 <- x at . - | null gs = L match_loc pp_pats - | otherwise = L grd_loc (pp_pats <+> vbar <+> interpp'SP gs) - L grd_loc _ = head gs - --- | Translate a guard statement to a 'GrdVec' -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM GrdVec -translateGuard fam_insts guard = case guard of - BodyStmt _ e _ _ -> translateBoolGuard e - LetStmt _ binds -> translateLet (unLoc binds) - BindStmt _ p e -> translateBind fam_insts p e - LastStmt {} -> panic "translateGuard LastStmt" - ParStmt {} -> panic "translateGuard ParStmt" - TransStmt {} -> panic "translateGuard TransStmt" - RecStmt {} -> panic "translateGuard RecStmt" - ApplicativeStmt {} -> panic "translateGuard ApplicativeLastStmt" - --- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM GrdVec -translateLet _binds = return [] - --- | Translate a pattern guard +desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre) +-- See 'GrdPatBind' for how this simply repurposes GrdGRHS. +desugarPatBind loc var pat = + PmPatBind . flip PmGRHS (L loc (ppr pat)) <$> desugarPat var pat + +desugarEmptyCase :: Id -> DsM PmEmptyCase +desugarEmptyCase var = pure PmEmptyCase { pe_var = var } + +-- | Desugar the non-empty 'Match'es of a 'MatchGroup'. +desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc)) + -> DsM (PmMatchGroup Pre) +desugarMatches vars matches = + PmMatchGroup <$> traverse (desugarMatch vars) matches + +-- Desugar a single match +desugarMatch :: [Id] -> LMatch GhcTc (LHsExpr GhcTc) -> DsM (PmMatch Pre) +desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do + pats' <- concat <$> zipWithM desugarLPat vars pats + grhss' <- desugarGRHSs match_loc (sep (map ppr pats)) grhss + -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss']) + return PmMatch { pm_pats = pats', pm_grhss = grhss' } + +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (NonEmpty (PmGRHS Pre)) +desugarGRHSs match_loc pp_pats grhss + = traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + +-- | Desugar a guarded right-hand side to a single 'GrdTree' +desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) +desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do + -- _loc points to the match separator (ie =, ->) that comes after the guards. + -- Hence we have to pass in the match_loc, which we use in case that the RHS + -- is unguarded. + -- pp_pats is the space-separated pattern of the current Match this + -- GRHS belongs to, so the @A B x@ part in @A B x | 0 <- x at . + let rhs_info = case gs of + [] -> L match_loc pp_pats + (L grd_loc _):_ -> L grd_loc (pp_pats <+> vbar <+> interpp'SP gs) + grds <- concatMapM (desugarGuard . unLoc) gs + pure PmGRHS { pg_grds = grds, pg_rhs = rhs_info } + +-- | Desugar a guard statement to a 'GrdVec' +desugarGuard :: GuardStmt GhcTc -> DsM GrdVec +desugarGuard guard = case guard of + BodyStmt _ e _ _ -> desugarBoolGuard e + LetStmt _ binds -> desugarLet (unLoc binds) + BindStmt _ p e -> desugarBind p e + LastStmt {} -> panic "desugarGuard LastStmt" + ParStmt {} -> panic "desugarGuard ParStmt" + TransStmt {} -> panic "desugarGuard TransStmt" + RecStmt {} -> panic "desugarGuard RecStmt" + ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" + +-- | Desugar let-bindings +desugarLet :: HsLocalBinds GhcTc -> DsM GrdVec +desugarLet _binds = return [] + +-- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM GrdVec -translateBind fam_insts p e = dsLExpr e >>= \case +desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM GrdVec +desugarBind p e = dsLExpr e >>= \case Var y | Nothing <- isDataConId_maybe y -- RHS is a variable, so that will allow us to omit the let - -> translateLPat fam_insts y p + -> desugarLPat y p rhs -> do - (x, grds) <- translateLPatV fam_insts p + (x, grds) <- desugarLPatV p pure (PmLet x rhs : grds) --- | Translate a boolean guard +-- | Desugar a boolean guard -- @e ==> let x = e; True <- x@ -translateBoolGuard :: LHsExpr GhcTc -> DsM GrdVec -translateBoolGuard e +desugarBoolGuard :: LHsExpr GhcTc -> DsM GrdVec +desugarBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) -- but it is trivial to solve so instead we give back an empty @@ -802,7 +805,7 @@ for a pattern match appear matter. Consider a situation similar to T5117: f (0:_) = () f (0:[]) = () -The latter clause is clearly redundant. Yet if we translate the second clause as +The latter clause is clearly redundant. Yet if we desugar the second clause as [x:xs' <- xs, [] <- xs', 0 <- x] @@ -814,52 +817,11 @@ translation would have been And we have to take in the guards on list cells into @mkListGrds at . -Note [Countering exponential blowup] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Precise pattern match exhaustiveness checking is necessarily exponential in -the size of some input programs. We implement a counter-measure in the form of -the -fmax-pmcheck-models flag, limiting the number of Deltas we check against -each pattern by a constant. - -How do we do that? Consider - - f True True = () - f True True = () - -And imagine we set our limit to 1 for the sake of the example. The first clause -will be checked against the initial Delta, {}. Doing so will produce an -Uncovered set of size 2, containing the models {x/~True} and {x~True,y/~True}. -Also we find the first clause to cover the model {x~True,y~True}. - -But the Uncovered set we get out of the match is too huge! We somehow have to -ensure not to make things worse as they are already, so we continue checking -with a singleton Uncovered set of the initial Delta {}. Why is this -sound (wrt. notion of the GADTs Meet their Match paper)? Well, it basically -amounts to forgetting that we matched against the first clause. The values -represented by {} are a superset of those represented by its two refinements -{x/~True} and {x~True,y/~True}. - -This forgetfulness becomes very apparent in the example above: By continuing -with {} we don't detect the second clause as redundant, as it again covers the -same non-empty subset of {}. So we don't flag everything as redundant anymore, -but still will never flag something as redundant that isn't. - -For exhaustivity, the converse applies: We will report @f@ as non-exhaustive -and report @f _ _@ as missing, which is a superset of the actual missing -matches. But soundness means we will never fail to report a missing match. - -This mechanism is implemented in 'throttle'. - -Guards are an extreme example in this regard, with #11195 being a particularly -dreadful example: Since their RHS are often pretty much unique, we split on a -variable (the one representing the RHS) that doesn't occur anywhere else in the -program, so we don't actually get useful information out of that split! - -Note [Translate CoPats] +Note [Desugar CoPats] ~~~~~~~~~~~~~~~~~~~~~~~ -The pattern match checker did not know how to handle coerced patterns `CoPat` -efficiently, which gave rise to #11276. The original approach translated -`CoPat`s: +The pattern match checker did not know how to handle coerced patterns +`CoPat` efficiently, which gave rise to #11276. The original approach +desugared `CoPat`s: pat |> co ===> x (pat <- (x |> co)) @@ -874,108 +836,92 @@ a lot of false warnings. But we can check whether the coercion is a hole or if it is just refl, in which case we can drop it. - -%************************************************************************ -%* * - Utilities for Pattern Match Checking -%* * -%************************************************************************ -} --- ---------------------------------------------------------------------------- --- * Basic utilities - -{- -Note [Extensions to GADTs Meet Their Match] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The GADTs Meet Their Match paper presents the formalism that GHC's coverage -checker adheres to. Since the paper's publication, there have been some -additional features added to the coverage checker which are not described in -the paper. This Note serves as a reference for these new features. - -* Value abstractions are severely simplified to the point where they are just - variables. The information about the shape of a variable is encoded in - the oracle state 'Delta' instead. -* Handling of uninhabited fields like `!Void`. - See Note [Strict argument type constraints] in GHC.HsToCore.PmCheck.Oracle. -* Efficient handling of literal splitting, large enumerations and accurate - redundancy warnings for `COMPLETE` groups through the oracle. - -Note [Filtering out non-matching COMPLETE sets] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Currently, conlikes in a COMPLETE set are simply grouped by the -type constructor heading the return type. This is nice and simple, but it does -mean that there are scenarios when a COMPLETE set might be incompatible with -the type of a scrutinee. For instance, consider (from #14135): - - data Foo a = Foo1 a | Foo2 a - - pattern MyFoo2 :: Int -> Foo Int - pattern MyFoo2 i = Foo2 i - - {-# COMPLETE Foo1, MyFoo2 #-} - - f :: Foo a -> a - f (Foo1 x) = x - -`f` has an incomplete pattern-match, so when choosing which constructors to -report as unmatched in a warning, GHC must choose between the original set of -data constructors {Foo1, Foo2} and the COMPLETE set {Foo1, MyFoo2}. But observe -that GHC shouldn't even consider the COMPLETE set as a possibility: the return -type of MyFoo2, Foo Int, does not match the type of the scrutinee, Foo a, since -there's no substitution `s` such that s(Foo Int) = Foo a. - -To ensure that GHC doesn't pick this COMPLETE set, it checks each pattern -synonym constructor's return type matches the type of the scrutinee, and if one -doesn't, then we remove the whole COMPLETE set from consideration. - -One might wonder why GHC only checks /pattern synonym/ constructors, and not -/data/ constructors as well. The reason is because that the type of a -GADT constructor very well may not match the type of a scrutinee, and that's -OK. Consider this example (from #14059): - - data SBool (z :: Bool) where - SFalse :: SBool False - STrue :: SBool True - - pattern STooGoodToBeTrue :: forall (z :: Bool). () - => z ~ True - => SBool z - pattern STooGoodToBeTrue = STrue - {-# COMPLETE SFalse, STooGoodToBeTrue #-} - - wobble :: SBool z -> Bool - wobble STooGoodToBeTrue = True - -In the incomplete pattern match for `wobble`, we /do/ want to warn that SFalse -should be matched against, even though its type, SBool False, does not match -the scrutinee type, SBool z. - -SG: Another angle at this is that the implied constraints when we instantiate -universal type variables in the return type of a GADT will lead to *provided* -thetas, whereas when we instantiate the return type of a pattern synonym that -corresponds to a *required* theta. See Note [Pattern synonym result type] in -PatSyn. Note how isValidCompleteMatches will successfully filter out - - pattern Just42 :: Maybe Int - pattern Just42 = Just 42 - -But fail to filter out the equivalent - - pattern Just'42 :: (a ~ Int) => Maybe a - pattern Just'42 = Just 42 - -Which seems fine as far as tcMatchTy is concerned, but it raises a few eye -brows. --} +-- +-- * Coverage checking guard trees into annotated trees +-- -{- -%************************************************************************ -%* * - Heart of the algorithm: checkGrdTree -%* * -%************************************************************************ --} +-- | Pattern-match coverage check result +data CheckResult a + = CheckResult + { cr_ret :: !a + -- ^ A hole for redundancy info and covered sets. + , cr_uncov :: !Deltas + -- ^ The set of uncovered values falling out at the bottom. + -- (for -Wincomplete-patterns, but also important state for the algorithm) + , cr_approx :: !Precision + -- ^ A flag saying whether we ran into the 'maxPmCheckModels' limit for the + -- purpose of suggesting to crank it up in the warning message. Writer state. + } deriving Functor + +instance Outputable a => Outputable (CheckResult a) where + ppr (CheckResult c unc pc) + = text "CheckResult" <+> ppr_precision pc <+> braces (fsep + [ field "ret" c <> comma + , field "uncov" unc]) + where + ppr_precision Precise = empty + ppr_precision Approximate = text "(Approximate)" + field name value = text name <+> equals <+> ppr value + +-- | Lift 'addPmCts' over 'Deltas'. +addPmCtsDeltas :: Deltas -> PmCts -> DsM Deltas +addPmCtsDeltas deltas cts = liftDeltasM (\d -> addPmCts d cts) deltas + +-- | 'addPmCtsDeltas' for a single 'PmCt'. +addPmCtDeltas :: Deltas -> PmCt -> DsM Deltas +addPmCtDeltas deltas ct = addPmCtsDeltas deltas (unitBag ct) + +-- | Test if any of the 'Delta's is inhabited. Currently this is pure, because +-- we preserve the invariant that there are no uninhabited 'Delta's. But that +-- could change in the future, for example by implementing this function in +-- terms of @notNull <$> provideEvidence 1 ds at . +isInhabited :: Deltas -> DsM Bool +isInhabited (MkDeltas ds) = pure (not (null ds)) + +-- | Coverage checking action. Can be composed 'leftToRight' or 'topToBottom'. +newtype CheckAction a = CA { unCA :: Deltas -> DsM (CheckResult a) } + deriving Functor + +-- | Composes 'CheckAction's top-to-bottom: +-- If a value falls through the resulting action, then it must fall through the +-- first action and then through the second action. +-- If a value matches the resulting action, then it either matches the +-- first action or matches the second action. +-- Basically the semantics of the LYG branching construct. +topToBottom :: (top -> bot -> ret) + -> CheckAction top + -> CheckAction bot + -> CheckAction ret +topToBottom f (CA top) (CA bot) = CA $ \inc -> do + t <- top inc + b <- bot (cr_uncov t) + pure CheckResult { cr_ret = f (cr_ret t) (cr_ret b) + , cr_uncov = cr_uncov b + , cr_approx = cr_approx t Semi.<> cr_approx b } + + +-- | Composes 'CheckAction's left-to-right: +-- If a value falls through the resulting action, then it either falls through the +-- first action or through the second action. +-- If a value matches the resulting action, then it must match the first action +-- and then match the second action. +-- Basically the semantics of the LYG guard construct. +leftToRight :: (RedSets -> right -> ret) + -> CheckAction RedSets + -> CheckAction right + -> CheckAction ret +leftToRight f (CA left) (CA right) = CA $ \inc -> do + l <- left inc + r <- right (rs_cov (cr_ret l)) + limit <- maxPmCheckModels <$> getDynFlags + let uncov = cr_uncov l Semi.<> cr_uncov r + -- See Note [Countering exponential blowup] + let (prec', uncov') = throttle limit inc uncov + pure CheckResult { cr_ret = f (cr_ret l) (cr_ret r) + , cr_uncov = uncov' + , cr_approx = prec' Semi.<> cr_approx l Semi.<> cr_approx r } -- | @throttle limit old new@ returns @old@ if the number of 'Delta's in @new@ -- is exceeding the given @limit@ and the @old@ number of 'Delta's. @@ -993,230 +939,226 @@ conMatchForces (PmAltConLike (RealDataCon dc)) | isNewTyCon (dataConTyCon dc) = False conMatchForces _ = True --- | Makes sure that we only wrap a single 'MayDiverge' around an --- 'AnnotatedTree', purely for esthetic reasons. -mayDiverge :: AnnotatedTree -> AnnotatedTree -mayDiverge a@(MayDiverge _) = a -mayDiverge a = MayDiverge a - --- | Computes two things: --- --- * The set of uncovered values not matched by any of the clauses of the --- 'GrdTree'. Note that 'PmCon' guards are the only way in which values --- fall through from one 'Many' branch to the next. --- * An 'AnnotatedTree' that contains divergence and inaccessibility info --- for all clauses. Will be fed to 'extractRedundancyInfo' for --- presenting redundant and proper innaccessible RHSs, as well as dead --- bangs to the user. -checkGrdTree' :: GrdTree -> Deltas -> DsM CheckResult --- RHS: Check that it covers something and wrap Inaccessible if not -checkGrdTree' (Rhs sdoc) deltas = do - is_covered <- isInhabited deltas - let clauses - | is_covered = AccessibleRhs deltas sdoc - | otherwise = InaccessibleRhs sdoc - pure CheckResult - { cr_clauses = clauses - , cr_uncov = MkDeltas emptyBag - , cr_approx = Precise } --- let x = e: Refine with x ~ e -checkGrdTree' (Guard (PmLet x e) tree) deltas = do - deltas' <- addPmCtDeltas deltas (PmCoreCt x e) - checkGrdTree' tree deltas' --- Bang x: Diverge on x ~ ⊥, refine with x /~ ⊥ -checkGrdTree' (Guard (PmBang x src_bang_info) tree) deltas = do - has_diverged <- addPmCtDeltas deltas (PmBotCt x) >>= isInhabited - deltas' <- addPmCtDeltas deltas (PmNotBotCt x) - res <- checkGrdTree' tree deltas' - let clauses - | not has_diverged - , Just info <- src_bang_info - = RedundantSrcBang info (cr_clauses res) - | has_diverged - = mayDiverge (cr_clauses res) - | otherwise -- won't diverge and it wasn't a source bang - = cr_clauses res - - pure res{ cr_clauses = clauses } - --- Con: Diverge on x ~ ⊥, fall through on x /~ K and refine with x ~ K ys --- and type info -checkGrdTree' (Guard (PmCon x con tvs dicts args) tree) deltas = do - has_diverged <- - if conMatchForces con - then addPmCtDeltas deltas (PmBotCt x) >>= isInhabited - else pure False - unc_this <- addPmCtDeltas deltas (PmNotConCt x con) - deltas' <- addPmCtsDeltas deltas $ - listToBag (PmTyCt . evVarPred <$> dicts) `snocBag` PmConCt x con tvs args - -- tracePm "checkGrdTree:Con" (ppr deltas $$ ppr x $$ ppr con $$ ppr dicts $$ ppr deltas') - CheckResult tree' unc_inner prec <- checkGrdTree' tree deltas' - limit <- maxPmCheckModels <$> getDynFlags - let (prec', unc') = throttle limit deltas (unc_this Semi.<> unc_inner) - pure CheckResult - { cr_clauses = applyWhen has_diverged mayDiverge tree' - , cr_uncov = unc' - , cr_approx = prec Semi.<> prec' } --- Sequence: Thread residual uncovered sets from equation to equation -checkGrdTree' (Sequence ts) init_unc = go [] init_unc Precise ts +-- First the functions that correspond to checking LYG primitives: + +checkSequence :: (grdtree -> CheckAction anntree) -> NonEmpty grdtree -> CheckAction (NonEmpty anntree) +-- The implementation is pretty similar to +-- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ +checkSequence act (t :| []) = (:| []) <$> act t +checkSequence act (t1 :| (t2:ts)) = + topToBottom (NE.<|) (act t1) (checkSequence act (t2:|ts)) + +checkGrd :: PmGrd -> CheckAction RedSets +checkGrd grd = CA $ \inc -> case grd of + -- let x = e: Refine with x ~ e + PmLet x e -> do + matched <- addPmCtDeltas inc (PmCoreCt x e) + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } + , cr_uncov = mempty + , cr_approx = Precise } + -- Bang x _: Diverge on x ~ ⊥, refine with x /~ ⊥ + PmBang x mb_info -> do + div <- addPmCtDeltas inc (PmBotCt x) + matched <- addPmCtDeltas inc (PmNotBotCt x) + -- See Note [Dead bang patterns] + -- mb_info = Just info <==> PmBang originates from bang pattern in source + let bangs | Just info <- mb_info = unitOL (div, info) + | otherwise = NilOL + pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } + , cr_uncov = mempty + , cr_approx = Precise } + -- Con: Diverge on x ~ ⊥, fall through on x /~ K and refine with x ~ K ys + -- and type info + PmCon x con tvs dicts args -> do + div <- if conMatchForces con + then addPmCtDeltas inc (PmBotCt x) + else pure mempty + uncov <- addPmCtDeltas inc (PmNotConCt x con) + matched <- addPmCtsDeltas inc $ + listToBag (PmTyCt . evVarPred <$> dicts) `snocBag` PmConCt x con tvs args + -- tracePm "checkGrd:Con" (ppr inc $$ ppr x $$ ppr con $$ ppr dicts $$ ppr matched) + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } + , cr_uncov = uncov + , cr_approx = Precise } + +checkGrds :: [PmGrd] -> CheckAction RedSets +checkGrds [] = CA $ \inc -> + pure CheckResult { cr_ret = emptyRedSets { rs_cov = inc } + , cr_uncov = mempty + , cr_approx = Precise } +checkGrds (g:grds) = leftToRight merge (checkGrd g) (checkGrds grds) where - -- | Accumulates a CheckResult. Its type is more like - -- @CheckResult -> [GrdTree] -> CheckResult@, but cr_clauses is a single - -- 'AnnotatedTree', not a list thereof. Hence 3 parameters to thread the - -- fields. - go :: [AnnotatedTree] -> Deltas -> Precision -> [GrdTree] -> DsM CheckResult - -- No cases left: Fall through for all values - go ts' unc prec [] = pure CheckResult - { cr_clauses = SequenceAnn init_unc (reverse ts') - , cr_uncov = unc - , cr_approx = prec } - go ts' unc prec (t:ts) = do - CheckResult t' unc_1 prec_t <- checkGrdTree' t unc - go (t':ts') unc_1 (prec_t Semi.<> prec) ts - --- | Print diagnostic info and actually call 'checkGrdTree''. -checkGrdTree :: GrdTree -> Deltas -> DsM CheckResult -checkGrdTree guards deltas = do - tracePm "checkGrdTree {" $ vcat [ ppr guards - , ppr deltas ] - res <- checkGrdTree' guards deltas - tracePm "checkGrdTree }:" (ppr res) -- braces are easier to match by tooling - return res - --- ---------------------------------------------------------------------------- --- * Propagation of term constraints inwards when checking nested matches - -{- Note [Type and Term Equality Propagation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When checking a match it would be great to have all type and term information -available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmVarCsDs' in GHC.HsToCore.Monad that store in the -environment type and term constraints (respectively) as we go deeper. - -The type constraints we propagate inwards are collected by `collectEvVarsPats' -in GHC.Hs.Pat. This handles bug #4139 ( see example - https://gitlab.haskell.org/ghc/ghc/snippets/672 ) -where this is needed. - -For term equalities we do less, we just generate equalities for HsCase. For -example we accurately give 2 redundancy warnings for the marked cases: - -f :: [a] -> Bool -f x = case x of - - [] -> case x of -- brings (x ~ []) in scope - [] -> True - (_:_) -> False -- can't happen - - (_:_) -> case x of -- brings (x ~ (_:_)) in scope - (_:_) -> True - [] -> False -- can't happen - -Functions `addScrutTmCs' is responsible for generating -these constraints. --} + merge ri_g ri_grds = -- This operation would /not/ form a Semigroup! + RedSets { rs_cov = rs_cov ri_grds + , rs_div = rs_div ri_g Semi.<> rs_div ri_grds + , rs_bangs = rs_bangs ri_g Semi.<> rs_bangs ri_grds } --- | Locally update 'dsl_deltas' with the given action, but defer evaluation --- with 'unsafeInterleaveM' in order not to do unnecessary work. -locallyExtendPmDelta :: (Deltas -> DsM Deltas) -> DsM a -> DsM a -locallyExtendPmDelta ext k = do - deltas <- getPmDeltas - deltas' <- unsafeInterleaveM $ do - deltas' <- ext deltas - inh <- isInhabited deltas' - -- If adding a constraint would lead to a contradiction, don't add it. - -- See @Note [Recovering from unsatisfiable pattern-matching constraints]@ - -- for why this is done. - if inh - then pure deltas' - else pure deltas - updPmDeltas deltas' k +checkMatchGroup :: PmMatchGroup Pre -> CheckAction (PmMatchGroup Post) +checkMatchGroup (PmMatchGroup matches) = + PmMatchGroup <$> checkSequence checkMatch matches --- | Add in-scope type constraints if the coverage checker might run and then --- run the given action. -addTyCsDs :: Origin -> Bag EvVar -> DsM a -> DsM a -addTyCsDs origin ev_vars m = do - dflags <- getDynFlags - applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmDelta (\deltas -> addPmCtsDeltas deltas (PmTyCt . evVarPred <$> ev_vars))) - m +checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) +checkMatch (PmMatch { pm_pats = grds, pm_grhss = grhss }) = + leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) --- | Add equalities for the scrutinee to the local 'DsM' environment when --- checking a case expression: --- case e of x { matches } --- When checking matches we record that (x ~ e) where x is the initial --- uncovered. All matches will have to satisfy this equality. -addScrutTmCs :: Maybe (LHsExpr GhcTc) -> [Id] -> DsM a -> DsM a -addScrutTmCs Nothing _ k = k -addScrutTmCs (Just scr) [x] k = do - scr_e <- dsLExpr scr - locallyExtendPmDelta (\deltas -> addPmCtsDeltas deltas (unitBag (PmCoreCt x scr_e))) k -addScrutTmCs _ _ _ = panic "addScrutTmCs: HsCase with more than one case binder" - -{- -%************************************************************************ -%* * - Pretty printing of exhaustiveness/redundancy check warnings -%* * -%************************************************************************ +checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) +checkGRHSs = checkSequence checkGRHS + +checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) +checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = + flip PmGRHS rhs_info <$> checkGrds grds + +checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase +checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do + unc <- addPmCtDeltas inc (PmNotBotCt var) + pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } + +checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) +checkPatBind = coerce checkGRHS + +{- Note [Countering exponential blowup] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Precise pattern match exhaustiveness checking is necessarily exponential in +the size of some input programs. We implement a counter-measure in the form of +the -fmax-pmcheck-models flag, limiting the number of Deltas we check against +each pattern by a constant. + +How do we do that? Consider + + f True True = () + f True True = () + +And imagine we set our limit to 1 for the sake of the example. The first clause +will be checked against the initial Delta, {}. Doing so will produce an +Uncovered set of size 2, containing the models {x/~True} and {x~True,y/~True}. +Also we find the first clause to cover the model {x~True,y~True}. + +But the Uncovered set we get out of the match is too huge! We somehow have to +ensure not to make things worse as they are already, so we continue checking +with a singleton Uncovered set of the initial Delta {}. Why is this +sound (wrt. the notion in GADTs Meet Their Match)? Well, it basically amounts +to forgetting that we matched against the first clause. The values represented +by {} are a superset of those represented by its two refinements {x/~True} and +{x~True,y/~True}. + +This forgetfulness becomes very apparent in the example above: By continuing +with {} we don't detect the second clause as redundant, as it again covers the +same non-empty subset of {}. So we don't flag everything as redundant anymore, +but still will never flag something as redundant that isn't. + +For exhaustivity, the converse applies: We will report @f@ as non-exhaustive +and report @f _ _@ as missing, which is a superset of the actual missing +matches. But soundness means we will never fail to report a missing match. + +This mechanism is implemented in 'throttle'. + +Guards are an extreme example in this regard, with #11195 being a particularly +dreadful example: Since their RHS are often pretty much unique, we split on a +variable (the one representing the RHS) that doesn't occur anywhere else in the +program, so we don't actually get useful information out of that split! -} --- | Check whether any part of pattern match checking is enabled for this --- 'HsMatchContext' (does not matter whether it is the redundancy check or the --- exhaustiveness check). -isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext id -> Bool -isMatchContextPmChecked dflags origin kind - | isGenerated origin - = False - | otherwise - = wopt Opt_WarnOverlappingPatterns dflags || exhaustive dflags kind +-- +-- * Collecting long-distance information +-- --- | Return True when any of the pattern match warnings ('allPmCheckWarnings') --- are enabled, in which case we need to run the pattern match checker. -needToRunPmCheck :: DynFlags -> Origin -> Bool -needToRunPmCheck dflags origin - | isGenerated origin - = False - | otherwise - = notNull (filter (`wopt` dflags) allPmCheckWarnings) +ldiMatchGroup :: PmMatchGroup Post -> NonEmpty (Deltas, NonEmpty Deltas) +ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches + +ldiMatch :: PmMatch Post -> (Deltas, NonEmpty Deltas) +ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = + (rs_cov red, ldiGRHS <$> grhss) + +ldiGRHS :: PmGRHS Post -> Deltas +ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red --- | A type for organising information to be used in warnings. -data RedundancyInfo - = RedundancyInfo - { redundant_rhss :: ![SrcInfo] - , inaccessible_rhss :: ![SrcInfo] - , redundant_bangs :: ![Located SDoc] +-- +-- * Collecting redundancy information +-- + +-- | The result of redundancy checking: +-- * RHSs classified as /C/overed, /I/naccessible and /R/edundant +-- * And redundant /B/ang patterns. See Note [Dead bang patterns]. +data CIRB + = CIRB + { cirb_cov :: !(OrdList SrcInfo) -- ^ Covered clauses + , cirb_inacc :: !(OrdList SrcInfo) -- ^ Inaccessible clauses + , cirb_red :: !(OrdList SrcInfo) -- ^ Redundant clauses + , cirb_bangs :: !(OrdList SrcInfo) -- ^ Redundant bang patterns } -extractRedundancyInfo :: AnnotatedTree -> RedundancyInfo -extractRedundancyInfo tree = - RedundancyInfo { redundant_rhss = fromOL ol_red - , inaccessible_rhss = fromOL ol_inacc - , redundant_bangs = fromOL ol_bangs } - where - (_ol_acc, ol_inacc, ol_red, ol_bangs) = go tree - -- | Collects - -- 1. accessible RHSs - -- 2. proper inaccessible RHSs (so we can't delete them) - -- 3. hypothetically redundant RHSs (so not only inaccessible, but we can - -- even safely delete the equation without altering semantics) - -- 4. 'Dead' bangs from the source, collected to be warned about - -- See Note [Determining inaccessible clauses] - -- See Note [Dead bang patterns] - go :: AnnotatedTree -> (OrdList SrcInfo, OrdList SrcInfo, OrdList SrcInfo, OrdList SrcInfo) - go (AccessibleRhs _ info) = (unitOL info, nilOL, nilOL , nilOL) - go (InaccessibleRhs info) = (nilOL, nilOL, unitOL info, nilOL) -- presumably redundant - go (MayDiverge t) = case go t of - -- See Note [Determining inaccessible clauses] - (acc, inacc, red, bs) - | isNilOL acc && isNilOL inacc -> (nilOL, red, nilOL, bs) - res -> res - go (SequenceAnn _ ts) = foldMap go ts - go (RedundantSrcBang l t) = case go t of - -- See Note [Dead bang patterns] - res@(acc, inacc, _, _) - | isNilOL acc, isNilOL inacc -> res - | otherwise -> (nilOL, nilOL, nilOL, unitOL l) Semi.<> res +instance Semigroup CIRB where + CIRB a b c d <> CIRB e f g h = CIRB (a <> e) (b <> f) (c <> g) (d <> h) + where (<>) = (Semi.<>) + +instance Monoid CIRB where + mempty = CIRB mempty mempty mempty mempty + +markAllRedundant :: CIRB -> CIRB +markAllRedundant CIRB { cirb_cov = cov, cirb_inacc = inacc, cirb_red = red } = + mempty { cirb_red = cov Semi.<> inacc Semi.<> red } + +-- See Note [Determining inaccessible clauses] +ensureOneNotRedundant :: CIRB -> CIRB +ensureOneNotRedundant ci = case ci of + CIRB { cirb_cov = NilOL, cirb_inacc = NilOL, cirb_red = ConsOL r rs } + -> ci { cirb_inacc = unitOL r, cirb_red = rs } + _ -> ci + +-- | Only adds the redundant bangs to the @CIRB@ if there is at least one +-- non-redundant 'SrcInfo'. There is no point in remembering a redundant bang +-- if the whole match is redundant! +addRedundantBangs :: OrdList SrcInfo -> CIRB -> CIRB +addRedundantBangs _red_bangs cirb at CIRB { cirb_cov = NilOL, cirb_inacc = NilOL } = + cirb +addRedundantBangs red_bangs cirb = + cirb { cirb_bangs = cirb_bangs cirb Semi.<> red_bangs } + +-- | Checks the 'Deltas' in a 'RedSets' for inhabitants and returns +-- 1. Whether the Covered set was inhabited +-- 2. Whether the Diverging set was inhabited +-- 3. All source bangs whose 'Deltas' were empty, which means they are +-- redundant. +testRedSets :: RedSets -> DsM (Bool, Bool, OrdList SrcInfo) +testRedSets RedSets { rs_cov = cov, rs_div = div, rs_bangs = bangs } = do + is_covered <- isInhabited cov + may_diverge <- isInhabited div + red_bangs <- flip mapMaybeM (fromOL bangs) $ \(deltas, bang) -> do + isInhabited deltas >>= \case + True -> pure Nothing + False -> pure (Just bang) + pure (is_covered, may_diverge, toOL red_bangs) + +cirbsMatchGroup :: PmMatchGroup Post -> DsM CIRB +cirbsMatchGroup (PmMatchGroup matches) = + Semi.sconcat <$> traverse cirbsMatch matches + +cirbsMatch :: PmMatch Post -> DsM CIRB +cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do + (is_covered, may_diverge, red_bangs) <- testRedSets red + cirb <- cirbsGRHSs grhss + pure $ addRedundantBangs red_bangs + -- See Note [Determining inaccessible clauses] + $ applyWhen may_diverge ensureOneNotRedundant + $ applyWhen (not is_covered) markAllRedundant + $ cirb + +cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB +cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss + +cirbsGRHS :: PmGRHS Post -> DsM CIRB +cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do + (is_covered, may_diverge, red_bangs) <- testRedSets red + let cirb | is_covered = mempty { cirb_cov = unitOL info } + | may_diverge = mempty { cirb_inacc = unitOL info } + | otherwise = mempty { cirb_red = unitOL info } + pure (addRedundantBangs red_bangs cirb) + +cirbsEmptyCase :: PmEmptyCase -> DsM CIRB +cirbsEmptyCase _ = pure mempty + +cirbsPatBind :: PmPatBind Post -> DsM CIRB +cirbsPatBind = coerce cirbsGRHS {- Note [Determining inaccessible clauses] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1231,26 +1173,29 @@ arguments we can ever reach clause 2's RHS, so we say it has inaccessible RHS (as opposed to being completely redundant). We detect an inaccessible RHS simply by pretending it's redundant, until we see -that it's part of a sub-tree in the pattern match that forces some argument -(which corresponds to wrapping the 'AnnotatedTree' in 'MayDiverge'). Then we -turn all supposedly redundant RHSs into inaccessible ones. - -But as it turns out (@g@ from #17465) this is too conservative: - g () | False = () - | otherwise = () -g's first clause has an inaccessible RHS, but it's also safe to delete. So it's -redundant, really! But by just turning all redundant child clauses into -inaccessible ones, we report the first clause as inaccessible. - -Clearly, it is enough if we say that we only degrade if *not all* of the child -clauses are redundant. As long as there is at least one clause which we announce -not to be redundant, the guard prefix responsible for the 'MayDiverge' will -survive. Hence we check for that in 'extractRedundancyInfo'. -} --- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) -dsPmWarn :: DynFlags -> DsMatchContext -> [Id] -> CheckResult -> DsM () -dsPmWarn dflags ctx@(DsMatchContext kind loc) vars result +-- +-- * Formatting and reporting warnings +-- + +-- | Given a function that collects 'CIRB's, this function will emit warnings +-- for a 'CheckResult'. +formatReportWarnings :: (ann -> DsM CIRB) -> DsMatchContext -> [Id] -> CheckResult ann -> DsM () +formatReportWarnings collect ctx vars cr at CheckResult { cr_ret = ann } = do + cov_info <- collect ann + dflags <- getDynFlags + reportWarnings dflags ctx vars cr{cr_ret=cov_info} + +-- | Issue all the warnings +-- (redundancy, inaccessibility, exhaustiveness, redundant bangs). +reportWarnings :: DynFlags -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () +reportWarnings dflags ctx@(DsMatchContext kind loc) vars + CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss + , cirb_red = redundant_rhss + , cirb_bangs = redundant_bangs } + , cr_uncov = uncovered + , cr_approx = precision } = when (flag_i || flag_u || flag_b) $ do unc_examples <- getNFirstUncovered vars (maxPatterns + 1) uncovered let exists_r = flag_i && notNull redundant_rhss @@ -1276,13 +1221,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) vars result when exists_u $ putSrcSpanDs loc $ warnDs flag_u_reason $ pprEqns vars unc_examples where - CheckResult - { cr_clauses = clauses - , cr_uncov = uncovered - , cr_approx = precision } = result - RedundancyInfo{redundant_rhss, inaccessible_rhss, redundant_bangs} - = extractRedundancyInfo clauses - flag_i = overlapping dflags kind flag_u = exhaustive dflags kind flag_b = redundant_bang dflags @@ -1323,44 +1261,30 @@ getNFirstUncovered vars n (MkDeltas deltas) = go n (bagToList deltas) back <- go (n - length front) deltas pure (front ++ back) -{- Note [Inaccessible warnings for record updates] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#12957) - data T a where - T1 :: { x :: Int } -> T Bool - T2 :: { x :: Int } -> T a - T3 :: T a - - f :: T Char -> T a - f r = r { x = 3 } - -The desugarer will (conservatively generate a case for T1 even though -it's impossible: - f r = case r of - T1 x -> T1 3 -- Inaccessible branch - T2 x -> T2 3 - _ -> error "Missing" - -We don't want to warn about the inaccessible branch because the programmer -didn't put it there! So we filter out the warning here. - -The same can happen for long distance term constraints instead of type -constraints (#17783): - - data T = A { x :: Int } | B { x :: Int } - f r at A{} = r { x = 3 } - f _ = B 0 - -Here, the long distance info from the FunRhs match (@r ~ A x@) will make the -clause matching on @B@ of the desugaring to @case@ redundant. It's generated -code that we don't want to warn about. --} - dots :: Int -> [a] -> SDoc dots maxPatterns qs | qs `lengthExceeds` maxPatterns = text "..." | otherwise = empty +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun + = vcat [text txt <+> msg, + sep [ text "In" <+> ppr_match <> char ':' + , nest 4 (rest_of_msg_fun pref)]] + where + txt | singular = "Pattern match" + | otherwise = "Pattern match(es)" + + (ppr_match, pref) + = case kind of + FunRhs { mc_fun = L _ fun } + -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) + _ -> (pprMatchContext kind, \ pp -> pp) + +-- +-- * Utilities +-- + -- | All warning flags that need to run the pattern match checker. allPmCheckWarnings :: [WarningFlag] allPmCheckWarnings = @@ -1399,23 +1323,142 @@ exhaustiveWarningFlag RecUpd = Just Opt_WarnIncompletePatternsRecUpd exhaustiveWarningFlag ThPatSplice = Nothing exhaustiveWarningFlag PatSyn = Nothing exhaustiveWarningFlag ThPatQuote = Nothing -exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete patterns - -- in list comprehensions, pattern guards - -- etc. They are often *supposed* to be - -- incomplete +-- Don't warn about incomplete patterns in list comprehensions, pattern guards +-- etc. They are often *supposed* to be incomplete +exhaustiveWarningFlag (StmtCtxt {}) = Nothing --- True <==> singular -pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun - = vcat [text txt <+> msg, - sep [ text "In" <+> ppr_match <> char ':' - , nest 4 (rest_of_msg_fun pref)]] - where - txt | singular = "Pattern match" - | otherwise = "Pattern match(es)" +-- | Check whether any part of pattern match checking is enabled for this +-- 'HsMatchContext' (does not matter whether it is the redundancy check or the +-- exhaustiveness check). +isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext id -> Bool +isMatchContextPmChecked dflags origin kind + | isGenerated origin + = False + | otherwise + = overlapping dflags kind || exhaustive dflags kind - (ppr_match, pref) - = case kind of - FunRhs { mc_fun = L _ fun } - -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) - _ -> (pprMatchContext kind, \ pp -> pp) +-- | Return True when any of the pattern match warnings ('allPmCheckWarnings') +-- are enabled, in which case we need to run the pattern match checker. +needToRunPmCheck :: DynFlags -> Origin -> Bool +needToRunPmCheck dflags origin + | isGenerated origin + = False + | otherwise + = notNull (filter (`wopt` dflags) allPmCheckWarnings) + +{- Note [Inaccessible warnings for record updates] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#12957) + data T a where + T1 :: { x :: Int } -> T Bool + T2 :: { x :: Int } -> T a + T3 :: T a + + f :: T Char -> T a + f r = r { x = 3 } + +The desugarer will conservatively generate a case for T1 even though +it's impossible: + f r = case r of + T1 x -> T1 3 -- Inaccessible branch + T2 x -> T2 3 + _ -> error "Missing" + +We don't want to warn about the inaccessible branch because the programmer +didn't put it there! So we filter out the warning here. + +The same can happen for long distance term constraints instead of type +constraints (#17783): + + data T = A { x :: Int } | B { x :: Int } + f r at A{} = r { x = 3 } + f _ = B 0 + +Here, the long distance info from the FunRhs match (@r ~ A x@) will make the +clause matching on @B@ of the desugaring to @case@ redundant. It's generated +code that we don't want to warn about. +-} + +-- +-- * Long-distance information +-- + +-- | Locally update 'dsl_deltas' with the given action, but defer evaluation +-- with 'unsafeInterleaveM' in order not to do unnecessary work. +locallyExtendPmDeltas :: (Deltas -> DsM Deltas) -> DsM a -> DsM a +locallyExtendPmDeltas ext k = do + deltas <- getLdiDeltas + deltas' <- unsafeInterleaveM $ ext deltas + updPmDeltas deltas' k + +-- | Add in-scope type constraints if the coverage checker might run and then +-- run the given action. +addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a +addTyCs origin ev_vars m = do + dflags <- getDynFlags + applyWhen (needToRunPmCheck dflags origin) + (locallyExtendPmDeltas (\deltas -> addPmCtsDeltas deltas (PmTyCt . evVarPred <$> ev_vars))) + m + +-- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment +-- when checking a case expression: +-- case e of x { matches } +-- When checking matches we record that (x ~ e) where x is the initial +-- uncovered. All matches will have to satisfy this equality. +addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a +addCoreScrutTmCs Nothing _ k = k +addCoreScrutTmCs (Just scr) [x] k = + flip locallyExtendPmDeltas k $ \deltas -> + addPmCtsDeltas deltas (unitBag (PmCoreCt x scr)) +addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" + +-- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. +addHsScrutTmCs :: Maybe (LHsExpr GhcTc) -> [Id] -> DsM a -> DsM a +addHsScrutTmCs Nothing _ k = k +addHsScrutTmCs (Just scr) vars k = do + scr_e <- dsLExpr scr + addCoreScrutTmCs (Just scr_e) vars k + +{- Note [Long-distance information] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + data Color = R | G | B + f :: Color -> Int + f R = … + f c = … (case c of + G -> True + B -> False) … + +Humans can make the "long-distance connection" between the outer pattern match +and the nested case pattern match to see that the inner pattern match is +exhaustive: @c@ can't be @R@ anymore because it was matched in the first clause +of @f at . + +To achieve similar reasoning in the coverage checker, we keep track of the set +of values that can reach a particular program point (often loosely referred to +as "Covered set") in 'GHC.HsToCore.Monad.dsl_deltas'. +We fill that set with Covered Deltas returned by the exported checking +functions, which the call sites put into place with +'GHC.HsToCore.Monad.updPmDeltas'. +Call sites also extend this set with facts from type-constraint dictionaries, +case scrutinees, etc. with the exported functions 'addTyCs', 'addCoreScrutTmCs' +and 'addHsScrutTmCs'. + +Note [Recovering from unsatisfiable pattern-matching constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the following code (see #12957 and #15450): + + f :: Int ~ Bool => () + f = case True of { False -> () } + +We want to warn that the pattern-matching in `f` is non-exhaustive. But GHC +used not to do this; in fact, it would warn that the match was /redundant/! +This is because the constraint (Int ~ Bool) in `f` is unsatisfiable, and the +coverage checker deems any matches with unsatisfiable constraint sets to be +unreachable. + +We make sure to always start from an inhabited 'Deltas' by calling +'getLdiDeltas', which falls back to the trivially inhabited 'Deltas' if the +long-distance info returned by 'GHC.HsToCore.Monad.getPmDeltas' is empty. +-} ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -167,25 +167,6 @@ mkOneConFull arg_tys con = do -- * Pattern match oracle -{- Note [Recovering from unsatisfiable pattern-matching constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the following code (see #12957 and #15450): - - f :: Int ~ Bool => () - f = case True of { False -> () } - -We want to warn that the pattern-matching in `f` is non-exhaustive. But GHC -used not to do this; in fact, it would warn that the match was /redundant/! -This is because the constraint (Int ~ Bool) in `f` is unsatisfiable, and the -coverage checker deems any matches with unsatisfiable constraint sets to be -unreachable. - -We decide to better than this. When beginning coverage checking, we first -check if the constraints in scope are unsatisfiable, and if so, we start -afresh with an empty set of constraints. This way, we'll get the warnings -that we expect. --} - ------------------------------------- -- * Composable satisfiability checks @@ -1266,7 +1247,7 @@ isTyConTriviallyInhabited tc = elementOfUniqSet tc triviallyInhabitedTyCons {- Note [Checking EmptyCase Expressions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Empty case expressions are strict on the scrutinee. That is, `case x of {}` -will force argument `x`. Hence, `checkMatches` is not sufficient for checking +will force argument `x`. Hence, `covCheckMatches` is not sufficient for checking empty cases, because it assumes that the match is not strict (which is true for all other cases, apart from EmptyCase). This gave rise to #10746. Instead, we do the following: ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -592,5 +592,8 @@ instance Outputable Deltas where instance Semigroup Deltas where MkDeltas l <> MkDeltas r = MkDeltas (l `unionBags` r) +instance Monoid Deltas where + mempty = MkDeltas emptyBag + liftDeltasM :: Monad m => (Delta -> m (Maybe Delta)) -> Deltas -> m Deltas liftDeltasM f (MkDeltas ds) = MkDeltas . catBagMaybes <$> (traverse f ds) ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -323,7 +323,7 @@ data DsLclEnv = DsLclEnv { dsl_meta :: DsMetaEnv, -- Template Haskell bindings dsl_loc :: RealSrcSpan, -- To put in pattern-matching error msgs - -- See Note [Note [Type and Term Equality Propagation] in "GHC.HsToCore.PmCheck" + -- See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck" -- The set of reaching values Deltas is augmented as we walk inwards, -- refined through each pattern match in turn dsl_deltas :: Deltas ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -556,9 +556,8 @@ isSingleton :: [a] -> Bool isSingleton [_] = True isSingleton _ = False -notNull :: [a] -> Bool -notNull [] = False -notNull _ = True +notNull :: Foldable f => f a -> Bool +notNull = not . null only :: [a] -> a #if defined(DEBUG) ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -35,6 +35,9 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do hasDynamic = elem dynamic ways mconcat [ arg "-Wall" , not useColor ? builder (Ghc CompileHs) ? + -- N.B. Target.trackArgument ignores this argument from the + -- input hash to avoid superfluous recompilation, avoiding + -- #18672. arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? ===================================== hadrian/src/Target.hs ===================================== @@ -21,11 +21,12 @@ type Target = H.Target Context Builder trackArgument :: Target -> String -> Bool trackArgument target arg = case builder target of Make _ -> not $ threadArg arg - Ghc _ _ -> not $ verbosityArg arg + Ghc _ _ -> not $ verbosityArg arg || diagnosticsColorArg arg Cabal _ _ -> not $ verbosityArg arg || cabal_configure_ignore arg _ -> True where threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="] verbosityArg s = dropWhileEnd isDigit s == "-v" + diagnosticsColorArg s = "-fdiagnostics-color=" `isPrefixOf` s -- N.B. #18672 cabal_configure_ignore s = s `elem` [ "--configure-option=--quiet", "--configure-option=--disable-option-checking" ] ===================================== includes/stg/Ticky.h ===================================== @@ -19,7 +19,7 @@ /* Here are all the counter declarations: */ /* If you change this list, make the corresponding change - in RTS_TICKY_SYMBOLS in rts/Linker.c */ + in RTS_TICKY_SYMBOLS in rts/RtsSymbols.c */ /* These two are explicitly declared in rts/Ticky.c, and hence should not be extern'd except when using this header ===================================== testsuite/tests/deSugar/should_compile/ds020.stderr ===================================== @@ -18,3 +18,11 @@ ds020.hs:20:1: warning: [-Woverlapping-patterns (in -Wdefault)] ds020.hs:23:1: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In an equation for ‘f’: f x@(~[]) = ... + +ds020.hs:32:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: (x1 : xs1 : ys1) = ... + +ds020.hs:33:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: (~x : ~xs : ~ys) = ... ===================================== testsuite/tests/module/all.T ===================================== @@ -83,7 +83,7 @@ test('mod61', normal, compile_fail, ['']) test('mod62', normal, compile_fail, ['']) test('mod63', normal, compile_fail, ['']) test('mod64', normal, compile, ['']) -test('mod65', normal, compile, ['']) +test('mod65', normal, compile, ['-Wno-overlapping-patterns']) test('mod66', normal, compile_fail, ['']) test('mod67', normal, compile_fail, ['']) test('mod68', normal, compile_fail, ['']) ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -1,3 +1,4 @@ + mod184.hs:6:8: warning: [-Wprepositive-qualified-module] Found ‘qualified’ in prepositive position Suggested fix: place ‘qualified’ after the module name instead. ===================================== testsuite/tests/pmcheck/should_compile/T18572.hs ===================================== @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -Wincomplete-uni-patterns -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE DataKinds, KindSignatures, GADTs #-} + +module T18572 where + +True = True -- no warning + +data SBool (b :: Bool) where + STrue :: SBool True + SFalse :: SBool False + +STrue = SFalse -- "redundant", not "inaccessible" ===================================== testsuite/tests/pmcheck/should_compile/T18572.stderr ===================================== @@ -0,0 +1,16 @@ + +T18572.hs:12:1: warning: [-Winaccessible-code (in -Wdefault)] + • Couldn't match type ‘'False’ with ‘'True’ + Inaccessible code in + a pattern with constructor: STrue :: SBool 'True, + in a pattern binding + • In the pattern: STrue + In a pattern binding: STrue = SFalse + +T18572.hs:12:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: STrue = ... + +T18572.hs:12:1: warning: [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: Patterns not matched: SFalse ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -102,6 +102,8 @@ test('T17234', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17248', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17340', normal, compile, + ['-Wredundant-bang-patterns']) test('T17357', expect_broken(17357), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17376', normal, compile, @@ -124,8 +126,8 @@ test('T18478', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18533', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17340', normal, compile, - ['-Wredundant-bang-patterns']) +test('T18572', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, ===================================== testsuite/tests/rename/should_compile/T7085.stderr ===================================== @@ -1,3 +1,7 @@ T7085.hs:8:6: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)] This pattern-binding binds no variables: Nothing = Just n + +T7085.hs:8:6: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: Nothing = ... ===================================== testsuite/tests/unboxedsums/all.T ===================================== @@ -30,5 +30,5 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) # extra_files([ "unboxedsums" + str(i) + ".hs" for i in range(1, 12) ])], # makefile_test, []) -test('UbxSumLevPoly', normal, compile, ['']) +test('UbxSumLevPoly', normal, compile, ['-Wno-overlapping-patterns']) test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06951c88af444da868309ab3056781296a5bb0fc...dfb03b7cba48ea8b829c2d2678048e89e45ee88a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06951c88af444da868309ab3056781296a5bb0fc...dfb03b7cba48ea8b829c2d2678048e89e45ee88a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 10:08:13 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 10 Sep 2020 06:08:13 -0400 Subject: [Git][ghc/ghc][wip/T14422] 42 commits: Fix FastString lexicographic ordering (fix #18562) Message-ID: <5f59fb0d63a05_80b88292741136152b@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14422 at Glasgow Haskell Compiler / GHC Commits: 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - f45c0591 by Sebastian Graf at 2020-09-09T17:20:40+02:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - cf1aa1ae by Sebastian Graf at 2020-09-09T18:24:23+02:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 6eafc6d7 by Sebastian Graf at 2020-09-09T18:27:48+02:00 .gitignore *.hiedb files - - - - - 592d57ee by Sebastian Graf at 2020-09-09T18:32:51+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 97ce5078 by Sebastian Graf at 2020-09-10T12:07:57+02:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Rules.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/56336b739d55dadf1f53d829e84ab1dc5e8e420c...97ce5078119764c24dcf0721db77cdfbbe9f9c9c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/56336b739d55dadf1f53d829e84ab1dc5e8e420c...97ce5078119764c24dcf0721db77cdfbbe9f9c9c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 11:42:37 2020 From: gitlab at gitlab.haskell.org (Vladislav Zavialov) Date: Thu, 10 Sep 2020 07:42:37 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/linear-types-caret Message-ID: <5f5a112da728f_80bf2bef6c11383353@gitlab.haskell.org.mail> Vladislav Zavialov pushed new branch wip/linear-types-caret at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/linear-types-caret You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 11:52:51 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 10 Sep 2020 07:52:51 -0400 Subject: [Git][ghc/ghc][wip/T18649] Care with implicit-parameter superclasses Message-ID: <5f5a13937d06b_80b3f84611d3128113886c6@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18649 at Glasgow Haskell Compiler / GHC Commits: 92763148 by Simon Peyton Jones at 2020-09-10T12:51:52+01:00 Care with implicit-parameter superclasses Two bugs, #18627 and #18649, had the same cause: we were not account for the fact that a constaint tuple might hide an implicit parameter. The solution is not hard: look for implicit parameters in superclasses. See Note [Local implicit parameters] in GHC.Core.Predicate. Then we use this new function in two places * The "short-cut solver" in GHC.Tc.Solver.Interact.shortCutSolver which simply didn't handle implicit parameters properly at all. This fixes #18627 * The specialiser, which should not specialise on implicit parameters This fixes #18649 There are some lingering worries (see Note [Local implicit parameters]) but things are much better. - - - - - 12 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Utils/TcType.hs - + testsuite/tests/simplCore/should_compile/T18649.hs - + testsuite/tests/simplCore/should_compile/T18649.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_run/T18627.hs - + testsuite/tests/typecheck/should_run/T18627.stdout - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2510,9 +2510,12 @@ mkCallUDs' env f args -- we decide on a case by case basis if we want to specialise -- on this argument; if so, SpecDict, if not UnspecArg mk_spec_arg arg (Anon InvisArg pred) - | type_determines_value (scaledThing pred) - , interestingDict env arg -- Note [Interesting dictionary arguments] + | not (isIPLikePred (scaledThing pred)) + -- See Note [Type determines value] + , interestingDict env arg + -- See Note [Interesting dictionary arguments] = SpecDict arg + | otherwise = UnspecArg mk_spec_arg _ (Anon VisArg _) @@ -2525,41 +2528,18 @@ mkCallUDs' env f args -- in specImports -- Use 'realIdUnfolding' to ignore the loop-breaker flag! - type_determines_value pred -- See Note [Type determines value] - = case classifyPredType pred of - ClassPred cls _ -> not (isIPClass cls) -- Superclasses can't be IPs - EqPred {} -> True - IrredPred {} -> True -- Things like (D []) where D is a - -- Constraint-ranged family; #7785 - ForAllPred {} -> True - -{- -Note [Type determines value] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Only specialise on non-IP *class* params, because these are the ones -whose *type* determines their *value*. In particular, with implicit -params, the type args *don't* say what the value of the implicit param -is! See #7101. +{- Note [Type determines value] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Only specialise on non-impicit-parameter predicates, because these +are the ones whose *type* determines their *value*. In particular, +with implicit params, the type args *don't* say what the value of the +implicit param is! See #7101. So we treat implicit params just like ordinary arguments for the purposes of specialisation. Note that we still want to specialise functions with implicit params if they have *other* dicts which are class params; see #17930. -One apparent additional complexity involves type families. For -example, consider - type family D (v::*->*) :: Constraint - type instance D [] = () - f :: D v => v Char -> Int -If we see a call (f "foo"), we'll pass a "dictionary" - () |> (g :: () ~ D []) -and it's good to specialise f at this dictionary. - -So the question is: can an implicit parameter "hide inside" a -type-family constraint like (D a). Well, no. We don't allow - type instance D Maybe = ?x:Int -Hence the IrredPred case in type_determines_value. See #7785. - Note [Interesting dictionary arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -22,7 +22,7 @@ module GHC.Core.Predicate ( getClassPredTys, getClassPredTys_maybe, -- Implicit parameters - isIPPred, isIPPred_maybe, isIPTyCon, isIPClass, hasIPPred, + isIPLikePred, hasIPSuperClasses, isIPTyCon, isIPClass, -- Evidence variables DictId, isEvVar, isDictId @@ -39,12 +39,10 @@ import GHC.Core.Multiplicity ( scaledThing ) import GHC.Builtin.Names -import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic -import Control.Monad ( guard ) -- | A predicate in the solver. The solver tries to prove Wanted predicates -- from Given ones. @@ -170,7 +168,7 @@ isEqPredClass :: Class -> Bool isEqPredClass cls = cls `hasKey` eqTyConKey || cls `hasKey` heqTyConKey -isClassPred, isEqPred, isEqPrimPred, isIPPred :: PredType -> Bool +isClassPred, isEqPred, isEqPrimPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tyCon | isClassTyCon tyCon -> True _ -> False @@ -186,9 +184,15 @@ isEqPred ty -- True of (a ~ b) and (a ~~ b) isEqPrimPred ty = isCoVarType ty -- True of (a ~# b) (a ~R# b) -isIPPred ty = case tyConAppTyCon_maybe ty of - Just tc -> isIPTyCon tc - _ -> False +isCTupleClass :: Class -> Bool +isCTupleClass cls = isTupleTyCon (classTyCon cls) + + +{- ********************************************************************* +* * + Implicit parameters +* * +********************************************************************* -} isIPTyCon :: TyCon -> Bool isIPTyCon tc = tc `hasKey` ipClassKey @@ -197,31 +201,105 @@ isIPTyCon tc = tc `hasKey` ipClassKey isIPClass :: Class -> Bool isIPClass cls = cls `hasKey` ipClassKey -isCTupleClass :: Class -> Bool -isCTupleClass cls = isTupleTyCon (classTyCon cls) +isIPLikePred :: Type -> Bool +-- See Note [Local implicit parameters] +isIPLikePred = is_ip_like_pred initIPRecTc -isIPPred_maybe :: Type -> Maybe (FastString, Type) -isIPPred_maybe ty = - do (tc,[t1,t2]) <- splitTyConApp_maybe ty - guard (isIPTyCon tc) - x <- isStrLitTy t1 - return (x,t2) - -hasIPPred :: PredType -> Bool -hasIPPred pred - = case classifyPredType pred of - ClassPred cls tys - | isIPClass cls -> True - | isCTupleClass cls -> any hasIPPred tys - _other -> False -{- -************************************************************************ +is_ip_like_pred :: RecTcChecker -> Type -> Bool +is_ip_like_pred rec_clss ty + | Just (tc, tys) <- splitTyConApp_maybe ty + , Just rec_clss' <- if isTupleTyCon tc -- Tuples never cause recursion + then Just rec_clss + else checkRecTc rec_clss tc + , Just cls <- tyConClass_maybe tc + = isIPClass cls || has_ip_super_classes rec_clss' cls tys + + | otherwise + = False -- Includes things like (D []) where D is + -- a Constraint-ranged family; #7785 + +hasIPSuperClasses :: Class -> [Type] -> Bool +-- See Note [Local implicit parameters] +hasIPSuperClasses = has_ip_super_classes initIPRecTc + +has_ip_super_classes :: RecTcChecker -> Class -> [Type] -> Bool +has_ip_super_classes rec_clss cls tys + = any ip_ish (classSCSelIds cls) + where + -- Check that the type of a superclass determines its value + -- sc_sel_id :: forall a b. C a b -> + ip_ish sc_sel_id = is_ip_like_pred rec_clss $ + funResultTy $ + piResultTys (varType sc_sel_id) tys + + +initIPRecTc :: RecTcChecker +initIPRecTc = setRecTcMaxBound 1 initRecTc + +{- Note [Local implicit parameters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The function isIPLikePred tells if this predicate, or any of its +superclasses, is an implicit parameter. + +Why are implicit parameters special? Unlike normal classes, we can +have local instances for implicit parameters, in the form of + let ?x = True in ... +So in various places we must be careful not to assume that any value +of the right type will do; we must carefully look for the innermost binding. +So isIPLikePred checks whether this is an implicit parameter, or has +a superclass that is an implicit parameter. + +Several wrinkles + +* We must be careful with superclasses, as #18649 showed. Haskell + doesn't allow an implicit parameter as a superclass + class (?x::a) => C a where ... + but with a constraint tuple we might have + (% Eq a, ?x::Int %) + and /its/ superclasses, namely (Eq a) and (?x::Int), /do/ include an + implicit parameter. + + With ConstraintKinds this can apply to /any/ class, e.g. + class sc => C sc where ... + Then (C (?x::Int)) has (?x::Int) as a superclass. So we must + instantiate and check each superclass, one by one, in + hasIPSuperClasses. + +* With -XRecursiveSuperClasses, the superclass hunt can go on forever, + so we need a RecTcChecker to cut it off. + +* Another apparent additional complexity involves type families. For + example, consider + type family D (v::*->*) :: Constraint + type instance D [] = () + f :: D v => v Char -> Int + If we see a call (f "foo"), we'll pass a "dictionary" + () |> (g :: () ~ D []) + and it's good to specialise f at this dictionary. + +So the question is: can an implicit parameter "hide inside" a +type-family constraint like (D a). Well, no. We don't allow + type instance D Maybe = ?x:Int +Hence the umbrella 'otherwise' case in is_ip_like_pred. See #7785. + +Small worries (Sept 20): +* I don't see what stops us having that 'type instance'. Indeed I + think nothing does. +* I'm a little concerned about type variables; such a variable might + be instantiated to an implicit parameter. I don't think this + matters in the cases for which isIPLikePred is used, and it's pretty + obscure anyway. +* The superclass hunt stops when it encounters the same class again, + but in principle we could have the same class, differently instantiated, + and the second time it could have an implicit parameter +I'm going to treat these as problems for another day. They are all exotic. -} + +{- ********************************************************************* * * Evidence variables * * -************************************************************************ --} +********************************************************************* -} isEvVar :: Var -> Bool isEvVar var = isEvVarType (varType var) ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1377,7 +1377,7 @@ growThetaTyVars theta tcvs | otherwise = transCloVarSet mk_next seed_tcvs where seed_tcvs = tcvs `unionVarSet` tyCoVarsOfTypes ips - (ips, non_ips) = partition isIPPred theta + (ips, non_ips) = partition isIPLikePred theta -- See Note [Inheriting implicit parameters] in GHC.Tc.Utils.TcType mk_next :: VarSet -> VarSet -- Maps current set to newly-grown ones ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -566,10 +566,10 @@ solveOneFromTheOther ev_i ev_w ev_id_w = ctEvEvId ev_w different_level_strategy -- Both Given - | isIPPred pred = if lvl_w > lvl_i then KeepWork else KeepInert - | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork + | isIPLikePred pred = if lvl_w > lvl_i then KeepWork else KeepInert + | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork -- See Note [Replacement vs keeping] (the different-level bullet) - -- For the isIPPred case see Note [Shadowing of Implicit Parameters] + -- For the isIPLikePred case see Note [Shadowing of Implicit Parameters] same_level_strategy binds -- Both Given | GivenOrigin (InstSC s_i) <- ctLocOrigin loc_i @@ -1071,6 +1071,8 @@ shortCutSolver dflags ev_w ev_i -- programs should typecheck regardless of whether we take this step or -- not. See Note [Shortcut solving] + && not (isIPLikePred (ctEvPred ev_w)) -- Not for implicit parameters (#18627) + && not (xopt LangExt.IncoherentInstances dflags) -- If IncoherentInstances is on then we cannot rely on coherence of proofs -- in order to justify this optimization: The proof provided by the @@ -1079,6 +1081,7 @@ shortCutSolver dflags ev_w ev_i && gopt Opt_SolveConstantDicts dflags -- Enabled by the -fsolve-constant-dicts flag + = do { ev_binds_var <- getTcEvBindsVar ; ev_binds <- ASSERT2( not (isCoEvBindsVar ev_binds_var ), ppr ev_w ) getTcEvBindsMap ev_binds_var ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2527,8 +2527,7 @@ emptyDictMap = emptyTcAppMap findDict :: DictMap a -> CtLoc -> Class -> [Type] -> Maybe a findDict m loc cls tys - | isCTupleClass cls - , any hasIPPred tys -- See Note [Tuples hiding implicit parameters] + | hasIPSuperClasses cls tys -- See Note [Tuples hiding implicit parameters] = Nothing | Just {} <- isCallStackPred cls tys ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -79,7 +79,7 @@ module GHC.Tc.Utils.TcType ( isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, isBoolTy, isUnitTy, isCharTy, isCallStackTy, isCallStackPred, - hasIPPred, isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, + isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, isPredTy, isTyVarClassPred, isTyVarHead, isInsolubleOccursCheck, checkValidClsArgs, hasTyVarHead, isRigidTy, isAlmostFunctionFree, @@ -141,7 +141,7 @@ module GHC.Tc.Utils.TcType ( mkTyConTy, mkTyVarTy, mkTyVarTys, mkTyCoVarTy, mkTyCoVarTys, - isClassPred, isEqPrimPred, isIPPred, isEqPred, isEqPredClass, + isClassPred, isEqPrimPred, isIPLikePred, isEqPred, isEqPredClass, mkClassPred, tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy, isRuntimeRepVar, isKindLevPoly, @@ -1747,7 +1747,7 @@ pickCapturedPreds pickCapturedPreds qtvs theta = filter captured theta where - captured pred = isIPPred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) + captured pred = isIPLikePred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) -- Superclasses ===================================== testsuite/tests/simplCore/should_compile/T18649.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} + +module Test where + +import Prelude + +type Hidden a = + ( ?enable :: a + , Eq a -- removing this "fixes" the issue + ) + +{-# NOINLINE a #-} +a :: Hidden Bool => Integer -> Bool +a _ = ?enable + +system :: Hidden Bool => Bool +system = a 0 + +topEntity :: Bool -> Bool +topEntity ena = let ?enable = ena + in system + +someVar = let ?enable = True + in system ===================================== testsuite/tests/simplCore/should_compile/T18649.stderr ===================================== @@ -0,0 +1,4 @@ + +==================== Tidy Core rules ==================== + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -333,3 +333,7 @@ test('T18347', normal, compile, ['-dcore-lint -O']) test('T18355', [ grep_errmsg(r'OneShot') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T18399', normal, compile, ['-dcore-lint -O']) test('T18589', normal, compile, ['-dcore-lint -O']) + +# T18649 should /not/ generate a specialisation rule +test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) + ===================================== testsuite/tests/typecheck/should_run/T18627.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Main where + +import GHC.Classes + +instance IP "x" Int where + ip = 21 + +baz :: (?x :: Int) => Int +baz = ?x + +main :: IO () +main = let ?x = 42 + in print baz ===================================== testsuite/tests/typecheck/should_run/T18627.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -146,3 +146,4 @@ test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, ['']) test('UnliftedNewtypesIdentityRun', normal, compile_and_run, ['']) test('UnliftedNewtypesCoerceRun', normal, compile_and_run, ['']) test('T17104', normal, compile_and_run, ['']) +test('T18627', normal, compile_and_run, ['-O']) # Optimisation shows up the bug View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92763148864d75b2096d999203dd3e18f8628eaf -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/92763148864d75b2096d999203dd3e18f8628eaf You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 12:32:18 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 10 Sep 2020 08:32:18 -0400 Subject: [Git][ghc/ghc][wip/T14422] PmCheck: Disattach COMPLETE pragma lookup from TyCons Message-ID: <5f5a1cd239fa3_80b3f848c65f9f0114006d@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14422 at Glasgow Haskell Compiler / GHC Commits: ebb3f815 by Sebastian Graf at 2020-09-10T14:32:05+02:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 22 changed files: - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/IfaceToCore.hs-boot - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Env.hs - docs/users_guide/exts/pragmas.rst - testsuite/tests/pmcheck/complete_sigs/completesig15.hs → testsuite/tests/pmcheck/complete_sigs/T14422.hs - + testsuite/tests/pmcheck/complete_sigs/T18277.hs - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/complete_sigs/completesig04.hs - testsuite/tests/pmcheck/complete_sigs/completesig04.stderr - − testsuite/tests/pmcheck/complete_sigs/completesig15.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Driver.Types ( lookupIfaceByModule, emptyPartialModIface, emptyFullModIface, lookupHptByModule, PackageInstEnv, PackageFamInstEnv, PackageRuleBase, - PackageCompleteMatchMap, + PackageCompleteMatches, mkSOName, mkHsSOName, soExt, @@ -146,8 +146,7 @@ module GHC.Driver.Types ( handleFlagWarnings, printOrThrowWarnings, -- * COMPLETE signature - CompleteMatch(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap, + ConLikeSet, CompleteMatch, CompleteMatches, -- * Exstensible Iface fields ExtensibleFields(..), FieldName, @@ -734,7 +733,7 @@ lookupIfaceByModule hpt pit mod -- of its own, but it doesn't seem worth the bother. hptCompleteSigs :: HscEnv -> [CompleteMatch] -hptCompleteSigs = hptAllThings (md_complete_sigs . hm_details) +hptCompleteSigs = hptAllThings (md_complete_matches . hm_details) -- | Find all the instance declarations (of classes and families) from -- the Home Package Table filtered by the provided predicate function. @@ -1092,7 +1091,7 @@ data ModIface_ (phase :: ModIfacePhase) -- itself) but imports some trustworthy modules from its own -- package (which does require its own package be trusted). -- See Note [Trust Own Package] in GHC.Rename.Names - mi_complete_sigs :: [IfaceCompleteMatch], + mi_complete_matches :: [IfaceCompleteMatch], mi_doc_hdr :: Maybe HsDocString, -- ^ Module header. @@ -1183,7 +1182,7 @@ instance Binary ModIface where mi_hpc = hpc_info, mi_trust = trust, mi_trust_pkg = trust_pkg, - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1229,7 +1228,7 @@ instance Binary ModIface where put_ bh hpc_info put_ bh trust put_ bh trust_pkg - put_ bh complete_sigs + put_ bh complete_matches lazyPut bh doc_hdr lazyPut bh decl_docs lazyPut bh arg_docs @@ -1262,7 +1261,7 @@ instance Binary ModIface where hpc_info <- get bh trust <- get bh trust_pkg <- get bh - complete_sigs <- get bh + complete_matches <- get bh doc_hdr <- lazyGet bh decl_docs <- lazyGet bh arg_docs <- lazyGet bh @@ -1286,7 +1285,7 @@ instance Binary ModIface where mi_trust = trust, mi_trust_pkg = trust_pkg, -- And build the cached values - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1331,7 +1330,7 @@ emptyPartialModIface mod mi_hpc = False, mi_trust = noIfaceTrustInfo, mi_trust_pkg = False, - mi_complete_sigs = [], + mi_complete_matches = [], mi_doc_hdr = Nothing, mi_decl_docs = emptyDeclDocMap, mi_arg_docs = emptyArgDocMap, @@ -1387,7 +1386,7 @@ data ModDetails md_rules :: ![CoreRule], -- ^ Domain may include 'Id's from other modules md_anns :: ![Annotation], -- ^ Annotations present in this module: currently -- they only annotate things also declared in this module - md_complete_sigs :: [CompleteMatch] + md_complete_matches :: [CompleteMatch] -- ^ Complete match pragmas for this module } @@ -1400,7 +1399,7 @@ emptyModDetails md_rules = [], md_fam_insts = [], md_anns = [], - md_complete_sigs = [] } + md_complete_matches = [] } -- | Records the modules directly imported by a module for extracting e.g. -- usage information, and also to give better error message @@ -1463,7 +1462,7 @@ data ModGuts -- ^ Files to be compiled with the C compiler mg_warns :: !Warnings, -- ^ Warnings declared in the module mg_anns :: [Annotation], -- ^ Annotations declared in this module - mg_complete_sigs :: [CompleteMatch], -- ^ Complete Matches + mg_complete_matches :: [CompleteMatch], -- ^ Complete Matches mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module @@ -2684,7 +2683,7 @@ type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv type PackageAnnEnv = AnnEnv -type PackageCompleteMatchMap = CompleteMatchMap +type PackageCompleteMatches = CompleteMatches -- | Information about other packages that we have slurped in by reading -- their interface files @@ -2746,8 +2745,8 @@ data ExternalPackageState -- from all the external-package modules eps_ann_env :: !PackageAnnEnv, -- ^ The total 'AnnEnv' accumulated -- from all the external-package modules - eps_complete_matches :: !PackageCompleteMatchMap, - -- ^ The total 'CompleteMatchMap' accumulated + eps_complete_matches :: !PackageCompleteMatches, + -- ^ The total 'CompleteMatches' accumulated -- from all the external-package modules eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external @@ -3203,83 +3202,14 @@ byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) ------------------------------------------- +type ConLikeSet = UniqDSet ConLike + -- | A list of conlikes which represents a complete pattern match. -- These arise from @COMPLETE@ signatures. +-- See also Note [Implementation of COMPLETE pragmas]. +type CompleteMatch = ConLikeSet --- See Note [Implementation of COMPLETE signatures] -data CompleteMatch = CompleteMatch { - completeMatchConLikes :: [Name] - -- ^ The ConLikes that form a covering family - -- (e.g. Nothing, Just) - , completeMatchTyCon :: Name - -- ^ The TyCon that they cover (e.g. Maybe) - } - -instance Outputable CompleteMatch where - ppr (CompleteMatch cl ty) = text "CompleteMatch:" <+> ppr cl - <+> dcolon <+> ppr ty - --- | A map keyed by the 'completeMatchTyCon' which has type Name. - --- See Note [Implementation of COMPLETE signatures] -type CompleteMatchMap = UniqFM Name [CompleteMatch] - -mkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap -mkCompleteMatchMap = extendCompleteMatchMap emptyUFM - -extendCompleteMatchMap :: CompleteMatchMap -> [CompleteMatch] - -> CompleteMatchMap -extendCompleteMatchMap = foldl' insertMatch - where - insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap - insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c] - -{- -Note [Implementation of COMPLETE signatures] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A COMPLETE signature represents a set of conlikes (i.e., constructors or -pattern synonyms) such that if they are all pattern-matched against in a -function, it gives rise to a total function. An example is: - - newtype Boolean = Boolean Int - pattern F, T :: Boolean - pattern F = Boolean 0 - pattern T = Boolean 1 - {-# COMPLETE F, T #-} - - -- This is a total function - booleanToInt :: Boolean -> Int - booleanToInt F = 0 - booleanToInt T = 1 - -COMPLETE sets are represented internally in GHC with the CompleteMatch data -type. For example, {-# COMPLETE F, T #-} would be represented as: - - CompleteMatch { complateMatchConLikes = [F, T] - , completeMatchTyCon = Boolean } - -Note that GHC was able to infer the completeMatchTyCon (Boolean), but for the -cases in which it's ambiguous, you can also explicitly specify it in the source -language by writing this: - - {-# COMPLETE F, T :: Boolean #-} - -For efficiency purposes, GHC collects all of the CompleteMatches that it knows -about into a CompleteMatchMap, which is a map that is keyed by the -completeMatchTyCon. In other words, you could have a multiple COMPLETE sets -for the same TyCon: - - {-# COMPLETE F, T1 :: Boolean #-} - {-# COMPLETE F, T2 :: Boolean #-} - -And looking up the values in the CompleteMatchMap associated with Boolean -would give you [CompleteMatch [F, T1] Boolean, CompleteMatch [F, T2] Boolean]. -dsGetCompleteMatches in GHC.HsToCore.Quote accomplishes this lookup. - -Also see Note [Typechecking Complete Matches] in GHC.Tc.Gen.Bind for a more detailed -explanation for how GHC ensures that all the conlikes in a COMPLETE set are -consistent. --} +type CompleteMatches = [CompleteMatch] -- | Foreign language of the phase if the phase deals with a foreign code phaseForeignLanguage :: Phase -> Maybe ForeignSrcLang ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -224,7 +224,7 @@ deSugar hsc_env mg_modBreaks = modBreaks, mg_safe_haskell = safe_mode, mg_trust_pkg = imp_trust_own_pkg imports, - mg_complete_sigs = complete_matches, + mg_complete_matches = complete_matches, mg_doc_hdr = doc_hdr, mg_decl_docs = decl_docs, mg_arg_docs = arg_docs ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -88,7 +88,6 @@ import GHC.Driver.Ppr import GHC.Utils.Error import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Types.Unique.FM ( lookupWithDefaultUFM_Directly ) import GHC.Types.Literal ( mkLitString ) import GHC.Types.CostCentre.State @@ -210,13 +209,15 @@ mkDsEnvsFromTcGbl :: MonadIO m -> m (DsGblEnv, DsLclEnv) mkDsEnvsFromTcGbl hsc_env msg_var tcg_env = do { cc_st_var <- liftIO $ newIORef newCostCentreState + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env this_mod = tcg_mod tcg_env type_env = tcg_type_env tcg_env rdr_env = tcg_rdr_env tcg_env fam_inst_env = tcg_fam_inst_env tcg_env - complete_matches = hptCompleteSigs hsc_env - ++ tcg_complete_matches tcg_env + complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ tcg_complete_matches tcg_env -- from the current module + ++ eps_complete_matches eps -- from imports ; return $ mkDsEnvs dflags this_mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches } @@ -239,13 +240,15 @@ initDsWithModGuts :: HscEnv -> ModGuts -> DsM a -> IO (Messages, Maybe a) initDsWithModGuts hsc_env guts thing_inside = do { cc_st_var <- newIORef newCostCentreState ; msg_var <- newIORef emptyMessages + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts) rdr_env = mg_rdr_env guts fam_inst_env = mg_fam_inst_env guts this_mod = mg_module guts - complete_matches = hptCompleteSigs hsc_env - ++ mg_complete_sigs guts + complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ mg_complete_matches guts -- from the current module + ++ eps_complete_matches eps -- from imports bindsToIds (NonRec v _) = [v] bindsToIds (Rec binds) = map fst binds @@ -281,7 +284,7 @@ initTcDsForSolver thing_inside thing_inside } mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv - -> IORef Messages -> IORef CostCentreState -> [CompleteMatch] + -> IORef Messages -> IORef CostCentreState -> CompleteMatches -> (DsGblEnv, DsLclEnv) mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches @@ -290,7 +293,6 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod) NotBoot real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1) - completeMatchMap = mkCompleteMatchMap complete_matches gbl_env = DsGblEnv { ds_mod = mod , ds_fam_inst_env = fam_inst_env , ds_if_env = (if_genv, if_lenv) @@ -299,7 +301,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var (mkHomeUnitFromFlags dflags) rdr_env , ds_msgs = msg_var - , ds_complete_matches = completeMatchMap + , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv @@ -533,18 +535,9 @@ dsGetFamInstEnvs dsGetMetaEnv :: DsM (NameEnv DsMetaVal) dsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) } --- | The @COMPLETE@ pragmas provided by the user for a given `TyCon`. -dsGetCompleteMatches :: TyCon -> DsM [CompleteMatch] -dsGetCompleteMatches tc = do - eps <- getEps - env <- getGblEnv - -- We index into a UniqFM from Name -> elt, for tyCon it holds that - -- getUnique (tyConName tc) == getUnique tc. So we lookup using the - -- unique directly instead. - let lookup_completes ufm = lookupWithDefaultUFM_Directly ufm [] (getUnique tc) - eps_matches_list = lookup_completes $ eps_complete_matches eps - env_matches_list = lookup_completes $ ds_complete_matches env - return $ eps_matches_list ++ env_matches_list +-- | The @COMPLETE@ pragmas that are in scope. +dsGetCompleteMatches :: DsM CompleteMatches +dsGetCompleteMatches = ds_complete_matches <$> getGblEnv dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal) dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (dsl_meta env) name) } ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -66,13 +66,13 @@ import GHC.Core.TyCo.Rep import GHC.Core.Type import GHC.Tc.Solver (tcNormalise, tcCheckSatisfiability) import GHC.Core.Unify (tcMatchTy) -import GHC.Tc.Types (completeMatchConLikes) import GHC.Core.Coercion import GHC.Utils.Monad hiding (foldlM) import GHC.HsToCore.Monad hiding (foldlM) import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv +import Control.Applicative ((<|>)) import Control.Monad (guard, mzero, when) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict @@ -80,7 +80,6 @@ import Data.Bifunctor (second) import Data.Either (partitionEithers) import Data.Foldable (foldlM, minimumBy, toList) import Data.List (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ord (comparing) import qualified Data.Semigroup as Semigroup import Data.Tuple (swap) @@ -105,11 +104,114 @@ mkPmId ty = getUniqueM >>= \unique -> ----------------------------------------------- -- * Caching possible matches of a COMPLETE set -markMatched :: ConLike -> PossibleMatches -> PossibleMatches -markMatched _ NoPM = NoPM -markMatched con (PM ms) = PM (del_one_con con <$> ms) +-- See Note [Implementation of COMPLETE pragmas] + +-- | Traverse the COMPLETE sets of 'ResidualCompleteMatches'. +trvRcm :: Applicative f => (ConLikeSet -> f ConLikeSet) -> ResidualCompleteMatches -> f ResidualCompleteMatches +trvRcm f (RCM vanilla pragmas) = RCM <$> traverse f vanilla + <*> traverse (traverse f) pragmas +-- | Update the COMPLETE sets of 'ResidualCompleteMatches'. +updRcm :: (ConLikeSet -> ConLikeSet) -> ResidualCompleteMatches -> ResidualCompleteMatches +updRcm f (RCM vanilla pragmas) = RCM (f <$> vanilla) (fmap f <$> pragmas) + +-- | A pseudo-'CompleteMatch' for the vanilla complete set of the given data +-- 'TyCon'. +-- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ +vanillaCompleteMatchTC :: TyCon -> Maybe ConLikeSet +vanillaCompleteMatchTC tc = + let -- | TYPE acts like an empty data type on the term-level (#14086), but + -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a + -- special case. + mb_dcs | tc == tYPETyCon = Just [] + | otherwise = tyConDataCons_maybe tc + in mkUniqDSet . map RealDataCon <$> mb_dcs + +-- | Initialise from 'dsGetCompleteMatches' (containing all COMPLETE pragmas) +-- if the given 'ResidualCompleteMatches' were empty. +addCompleteMatches :: ResidualCompleteMatches -> DsM ResidualCompleteMatches +addCompleteMatches (RCM v Nothing) = RCM v . Just <$> dsGetCompleteMatches +addCompleteMatches rcm = pure rcm + +-- | Adds the declared 'CompleteMatches' from COMPLETE pragmas, as well as the +-- vanilla data defn if it is a 'DataCon'. +addConLikeMatches :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addConLikeMatches (RealDataCon dc) rcm = addTyConMatches (dataConTyCon dc) rcm +addConLikeMatches (PatSynCon _) rcm = addCompleteMatches rcm + +-- | Adds +-- * the 'CompleteMatches' from COMPLETE pragmas +-- * and the /vanilla/ 'CompleteMatch' from the data 'TyCon' +-- to the 'ResidualCompleteMatches', if not already present. +addTyConMatches :: TyCon -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addTyConMatches tc rcm = add_tc_match <$> addCompleteMatches rcm where - del_one_con = flip delOneFromUniqDSet + -- | Add the vanilla COMPLETE set from the data defn, if any. But only if + -- it's not already present. + add_tc_match rcm + = rcm{rcm_vanilla = rcm_vanilla rcm <|> vanillaCompleteMatchTC tc} + +markMatched :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +markMatched cl rcm = do + rcm' <- addConLikeMatches cl rcm + pure $ updRcm (flip delOneFromUniqDSet cl) rcm' + +{- +Note [Implementation of COMPLETE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A COMPLETE set represents a set of conlikes (i.e., constructors or +pattern synonyms) such that if they are all pattern-matched against in a +function, it gives rise to a total function. An example is: + + newtype Boolean = Boolean Int + pattern F, T :: Boolean + pattern F = Boolean 0 + pattern T = Boolean 1 + {-# COMPLETE F, T #-} + + -- This is a total function + booleanToInt :: Boolean -> Int + booleanToInt F = 0 + booleanToInt T = 1 + +COMPLETE sets are represented internally in GHC a set of 'ConLike's. For +example, the pragma {-# COMPLETE F, T #-} would be represented as: + + {F, T} + +GHC collects all COMPLETE pragmas from the current module and from imports +into a field in the DsM environment, which can be accessed with +dsGetCompleteMatches from "GHC.HsToCore.Monad". +Currently, COMPLETE pragmas can't be orphans (e.g. at least one ConLike must +also be defined in the module of the pragma) and do not impact recompilation +checking (#18675). + +The pattern-match checker will then initialise each variable's 'VarInfo' with +*all* imported COMPLETE sets (in 'GHC.HsToCore.PmCheck.Oracle.addCompleteMatches'), +well-typed or not, into a 'ResidualCompleteMatches'. The trick is that a +COMPLETE set that is ill-typed for that match variable could never be written by +the user! And we make sure not to report any ill-typed COMPLETE sets when +formatting 'Nabla's for warnings in 'provideEvidence'. + +A 'ResidualCompleteMatches' is a list of all COMPLETE sets, minus the ConLikes +we know a particular variable can't be (through negative constructor constraints + at x /~ K@ or a failed attempt at instantiating that ConLike during inhabitation +testing). If *any* of the COMPLETE sets become empty, we know that the match +was exhaustive. + +We assume that a COMPLETE set is non-empty if for one of its ConLikes +we fail to 'guessConLikeUnivTyArgsFromResTy'. That accounts for ill-typed +COMPLETE sets. So why don't we simply prune those ill-typed COMPLETE sets from +'ResidualCompleteMatches'? The answer is that additional type constraints might +make more COMPLETE sets applicable! Example: + + f :: a -> a :~: Boolean -> () + f x Refl | T <- x = () + | F <- x = () + +If we eagerly prune {F,T} from the residual matches of @x@, then we don't see +that the match in the guards of @f@ is exhaustive, where the COMPLETE set +applies due to refined type information. +-} --------------------------------------------------- -- * Instantiating constructors, types and evidence @@ -492,7 +594,7 @@ tyOracle (TySt inert) cts -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. Doesn't bother calling out to the type oracle if the bag of new type --- constraints was empty. Will only recheck 'PossibleMatches' in the term oracle +-- constraints was empty. Will only recheck 'ResidualCompleteMatches' in the term oracle -- for emptiness if the first argument is 'True'. tyIsSatisfiable :: Bool -> Bag PredType -> SatisfiabilityCheck tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \nabla -> @@ -544,10 +646,10 @@ of a PatSynCon (Just42,[]), this solution is incomparable to both Nothing and Just. Hence we retain the info in vi_neg, which eventually allows us to detect the complete pattern match. -The Pos/Neg invariant extends to vi_cache, which stores essentially positive -information. We make sure that vi_neg and vi_cache never overlap. This isn't -strictly necessary since vi_cache is just a cache, so doesn't need to be -accurate: Every suggestion of a possible ConLike from vi_cache might be +The Pos/Neg invariant extends to vi_rcm, which stores essentially positive +information. We make sure that vi_neg and vi_rcm never overlap. This isn't +strictly necessary since vi_rcm is just a cache, so doesn't need to be +accurate: Every suggestion of a possible ConLike from vi_rcm might be refutable by the type oracle anyway. But it helps to maintain sanity while debugging traces. @@ -568,7 +670,7 @@ The term oracle state is never obviously (i.e., without consulting the type oracle) contradictory. This implies a few invariants: * Whenever vi_pos overlaps with vi_neg according to 'eqPmAltCon', we refute. This is implied by the Note [Pos/Neg invariant]. -* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_cache to +* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_rcm to detect this, but we could just compare whole COMPLETE sets to vi_neg every time, if it weren't for performance. @@ -624,13 +726,16 @@ tmIsSatisfiable new_tm_cs = SC $ \nabla -> runMaybeT $ foldlM addTmCt nabla new_ ----------------------- -- * Looking up VarInfo +emptyRCM :: ResidualCompleteMatches +emptyRCM = RCM Nothing Nothing + emptyVarInfo :: Id -> VarInfo -- We could initialise @bot@ to @Just False@ in case of an unlifted type here, -- but it's cleaner to let the user of the constraint solver take care of this. -- After all, there are also strict fields, the unliftedness of which isn't -- evident in the type. So treating unlifted types here would never be -- sufficient anyway. -emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot NoPM +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot emptyRCM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' @@ -656,85 +761,6 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of | isNewDataCon dc = Just y go _ = Nothing -initPossibleMatches :: TyState -> VarInfo -> DsM VarInfo -initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do - -- New evidence might lead to refined info on ty, in turn leading to discovery - -- of a COMPLETE set. - res <- pmTopNormaliseType ty_st ty - let ty' = normalisedSourceType res - case splitTyConApp_maybe ty' of - Nothing -> pure vi{ vi_ty = ty' } - Just (tc, [_]) - | tc == tYPETyCon - -- TYPE acts like an empty data type on the term-level (#14086), but - -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a - -- special case. - -> pure vi{ vi_ty = ty', vi_cache = PM (pure emptyUniqDSet) } - Just (tc, tc_args) -> do - -- See Note [COMPLETE sets on data families] - (tc_rep, tc_fam) <- case tyConFamInst_maybe tc of - Just (tc_fam, _) -> pure (tc, tc_fam) - Nothing -> do - env <- dsGetFamInstEnvs - let (tc_rep, _tc_rep_args, _co) = tcLookupDataFamInst env tc tc_args - pure (tc_rep, tc) - -- Note that the common case here is tc_rep == tc_fam - let mb_rdcs = map RealDataCon <$> tyConDataCons_maybe tc_rep - let rdcs = maybeToList mb_rdcs - -- NB: tc_fam, because COMPLETE sets are associated with the parent data - -- family TyCon - pragmas <- dsGetCompleteMatches tc_fam - let fams = mapM dsLookupConLike . completeMatchConLikes - pscs <- mapM fams pragmas - -- pprTrace "initPossibleMatches" (ppr ty $$ ppr ty' $$ ppr tc_rep <+> ppr tc_fam <+> ppr tc_args $$ ppr (rdcs ++ pscs)) (return ()) - case NonEmpty.nonEmpty (rdcs ++ pscs) of - Nothing -> pure vi{ vi_ty = ty' } -- Didn't find any COMPLETE sets - Just cs -> pure vi{ vi_ty = ty', vi_cache = PM (mkUniqDSet <$> cs) } -initPossibleMatches _ vi = pure vi - -{- Note [COMPLETE sets on data families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -User-defined COMPLETE sets involving data families are attached to the family -TyCon, whereas the built-in COMPLETE set is attached to a data family instance's -representation TyCon. This matters for COMPLETE sets involving both DataCons -and PatSyns (from #17207): - - data family T a - data family instance T () = A | B - pattern C = B - {-# COMPLETE A, C #-} - f :: T () -> () - f A = () - f C = () - -The match on A is actually wrapped in a CoPat, matching impedance between T () -and its representation TyCon, which we translate as - at x | let y = x |> co, A <- y@ in PmCheck. - -Which TyCon should we use for looking up the COMPLETE set? The representation -TyCon from the match on A would only reveal the built-in COMPLETE set, while the -data family TyCon would only give the user-defined one. But when initialising -the PossibleMatches for a given Type, we want to do so only once, because -merging different COMPLETE sets after the fact is very complicated and possibly -inefficient. - -So in fact, we just *drop* the coercion arising from the CoPat when handling -handling the constraint @y ~ x |> co@ in addCoreCt, just equating @y ~ x at . -We then handle the fallout in initPossibleMatches, which has to get a hand at -both the representation TyCon tc_rep and the parent data family TyCon tc_fam. -It considers three cases after having established that the Type is a TyConApp: - -1. The TyCon is a vanilla data type constructor -2. The TyCon is tc_rep -3. The TyCon is tc_fam - -1. is simple and subsumed by the handling of the other two. -We check for case 2. by 'tyConFamInst_maybe' and get the tc_fam out. -Otherwise (3.), we try to lookup the data family instance at that particular -type to get out the tc_rep. In case 1., this will just return the original -TyCon, so tc_rep = tc_fam afterwards. --} - ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -897,11 +923,7 @@ addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do - -- For good performance, it's important to initPossibleMatches here. - -- Otherwise we can't mark nalt as matched later on, incurring unnecessary - -- inhabitation tests for nalt. - vi@(VI _ pos neg _ pm) <- lift $ initPossibleMatches (nabla_ty_st nabla) - (lookupVarInfo ts x) + let vi@(VI _ pos neg _ rcm) = lookupVarInfo ts x -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt (cl, _tvs, _args) = eqPmAltCon cl nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -917,9 +939,11 @@ addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor vi2 <- case nalt of - PmAltConLike cl - -> ensureInhabited nabla vi1{ vi_cache = markMatched cl pm } - _ -> pure vi1 + PmAltConLike cl -> do + rcm' <- lift (markMatched cl rcm) + ensureInhabited nabla vi1{ vi_rcm = rcm' } + _ -> + pure vi1 pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } hasRequiredTheta :: PmAltCon -> Bool @@ -963,13 +987,15 @@ storing required arguments along with the PmAltConLike in 'vi_neg'. -- its result type. Rather easy for DataCons, but not so much for PatSynCons. -- See Note [Pattern synonym result type] in "GHC.Core.PatSyn". guessConLikeUnivTyArgsFromResTy :: FamInstEnvs -> Type -> ConLike -> Maybe [Type] -guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon _) = do +guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon dc) = do (tc, tc_args) <- splitTyConApp_maybe res_ty -- Consider data families: In case of a DataCon, we need to translate to -- the representation TyCon. For PatSyns, they are relative to the data -- family TyCon, so we don't need to translate them. - let (_, tc_args', _) = tcLookupDataFamInst env tc tc_args - Just tc_args' + let (rep_tc, tc_args', _) = tcLookupDataFamInst env tc tc_args + if rep_tc == dataConTyCon dc + then Just tc_args' + else Nothing guessConLikeUnivTyArgsFromResTy _ res_ty (PatSynCon ps) = do -- We are successful if we managed to instantiate *every* univ_tv of con. -- This is difficult and bound to fail in some cases, see @@ -998,7 +1024,7 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do -- | Returns (Just vi) if at least one member of each ConLike in the COMPLETE -- set satisfies the oracle -- --- Internally uses and updates the ConLikeSets in vi_cache. +-- Internally uses and updates the ConLikeSets in vi_rcm. -- -- NB: Does /not/ filter each ConLikeSet with the oracle; members may -- remain that do not statisfy it. This lazy approach just @@ -1007,17 +1033,32 @@ ensureInhabited :: Nabla -> VarInfo -> MaybeT DsM VarInfo ensureInhabited nabla vi = case vi_bot vi of MaybeBot -> pure vi -- The |-Bot rule from the paper IsBot -> pure vi - IsNotBot -> lift (initPossibleMatches (nabla_ty_st nabla) vi) >>= inst_complete_sets + IsNotBot -> lift (add_matches vi) >>= inst_complete_sets where + add_matches :: VarInfo -> DsM VarInfo + add_matches vi = do + res <- pmTopNormaliseType (nabla_ty_st nabla) (vi_ty vi) + rcm <- case reprTyCon_maybe (normalisedSourceType res) of + Just tc -> addTyConMatches tc (vi_rcm vi) + Nothing -> addCompleteMatches (vi_rcm vi) + pure vi{ vi_rcm = rcm } + + reprTyCon_maybe :: Type -> Maybe TyCon + reprTyCon_maybe ty = case splitTyConApp_maybe ty of + Nothing -> Nothing + Just (tc, _args) -> case tyConFamInst_maybe tc of + Nothing -> Just tc + Just (tc_fam, _) -> Just tc_fam + -- | This is the |-Inst rule from the paper (section 4.5). Tries to -- find an inhabitant in every complete set by instantiating with one their -- constructors. If there is any complete set where we can't find an -- inhabitant, the whole thing is uninhabited. + -- See also Note [Implementation of COMPLETE pragmas]. inst_complete_sets :: VarInfo -> MaybeT DsM VarInfo - inst_complete_sets vi at VI{ vi_cache = NoPM } = pure vi - inst_complete_sets vi at VI{ vi_cache = PM ms } = do - ms <- traverse (\cs -> inst_complete_set vi cs (uniqDSetToList cs)) ms - pure vi{ vi_cache = PM ms } + inst_complete_sets vi at VI{ vi_rcm = rcm } = do + rcm' <- trvRcm (\cls -> inst_complete_set vi cls (uniqDSetToList cls)) rcm + pure vi{ vi_rcm = rcm' } inst_complete_set :: VarInfo -> ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet -- (inst_complete_set cs cls) iterates over cls, deleting from cs @@ -1052,7 +1093,7 @@ ensureInhabited nabla vi = case vi_bot vi of ] -- | Checks if every 'VarInfo' in the term oracle has still an inhabited --- 'vi_cache', considering the current type information in 'Nabla'. +-- 'vi_rcm', considering the current type information in 'Nabla'. -- This check is necessary after having matched on a GADT con to weed out -- impossible matches. ensureAllInhabited :: Nabla -> DsM (Maybe Nabla) @@ -1111,7 +1152,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- Do the same for negative info let add_refut nabla nalt = addNotConCt nabla y nalt nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) - -- vi_cache will be updated in addNotConCt, so we are good to + -- vi_rcm will be updated in addNotConCt, so we are good to -- go! pure nabla_neg @@ -1123,7 +1164,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do - let VI ty pos neg bot cache = lookupVarInfo ts x + let VI ty pos neg bot rcm = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -1142,7 +1183,8 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do MaybeT $ addPmCts nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = (alt, tvs, args):pos - let nabla_with bot = nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot cache)) reps} + let nabla_with bot = + nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot rcm)) reps} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -1574,7 +1616,7 @@ provideEvidence = go try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. try_instantiate x xs n nabla = do - (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) let build_newtype (x, nabla) (_ty, dc, arg_ty) = do y <- lift $ mkPmId arg_ty -- Newtypes don't have existentials (yet?!), so passing an empty @@ -1586,11 +1628,13 @@ provideEvidence = go Just (y, newty_nabla) -> do -- Pick a COMPLETE set and instantiate it (n at max). Take care of ⊥. let vi = lookupVarInfo (nabla_tm_st newty_nabla) y - vi <- initPossibleMatches (nabla_ty_st newty_nabla) vi - mb_cls <- pickMinimalCompleteSet newty_nabla (vi_cache vi) + rcm <- case splitTyConApp_maybe rep_ty of + Nothing -> pure (vi_rcm vi) + Just (tc, _) -> addTyConMatches tc (vi_rcm vi) + mb_cls <- pickMinimalCompleteSet rep_ty rcm case uniqDSetToList <$> mb_cls of Just cls -> do - nablas <- instantiate_cons y core_ty xs n newty_nabla cls + nablas <- instantiate_cons y rep_ty xs n newty_nabla cls if null nablas && vi_bot vi /= IsNotBot then go xs n newty_nabla -- bot is still possible. Display a wildcard! else pure nablas @@ -1632,13 +1676,15 @@ provideEvidence = go other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls pure (con_nablas ++ other_cons_nablas) -pickMinimalCompleteSet :: Nabla -> PossibleMatches -> DsM (Maybe ConLikeSet) -pickMinimalCompleteSet _ NoPM = pure Nothing --- TODO: First prune sets with type info in nabla. But this is good enough for --- now and less costly. See #17386. -pickMinimalCompleteSet _ (PM clss) = do - tracePm "pickMinimalCompleteSet" (ppr $ NonEmpty.toList clss) - pure (Just (minimumBy (comparing sizeUniqDSet) clss)) +pickMinimalCompleteSet :: Type -> ResidualCompleteMatches -> DsM (Maybe ConLikeSet) +pickMinimalCompleteSet ty rcm = do + env <- dsGetFamInstEnvs + pure $ case filter (all (is_valid env) . uniqDSetToList) (getRcm rcm) of + [] -> Nothing + clss' -> Just (minimumBy (comparing sizeUniqDSet) clss') + where + is_valid :: FamInstEnvs -> ConLike -> Bool + is_valid env cl = isJust (guessConLikeUnivTyArgsFromResTy env ty cl) -- | Finds a representant of the semantic equality class of the given @e at . -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -24,8 +24,8 @@ module GHC.HsToCore.PmCheck.Types ( literalToPmLit, negatePmLit, overloadPmLit, pmLitAsStringLit, coreExprAsPmLit, - -- * Caching partially matched COMPLETE sets - ConLikeSet, PossibleMatches(..), + -- * Caching residual COMPLETE sets + ConLikeSet, ResidualCompleteMatches(..), getRcm, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -69,10 +69,10 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) import Data.Foldable (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ratio import qualified Data.Semigroup as Semi @@ -415,21 +415,32 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show -type ConLikeSet = UniqDSet ConLike +-- | A data type that caches for the 'VarInfo' of @x@ the results of querying +-- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for +-- which we already know @x /~ K@ from these sets. +-- +-- For motivation, see Section 5.3 in Lower Your Guards. +-- See also Note [Implementation of COMPLETE pragmas] +data ResidualCompleteMatches + = RCM + { rcm_vanilla :: !(Maybe ConLikeSet) + -- ^ The residual set for the vanilla COMPLETE set from the data defn. + -- Tracked separately from 'rcm_pragmas', because it might only be + -- known much later (when we have enough type information to see the 'TyCon' + -- of the match), or not at all even. Until that happens, it is 'Nothing'. + , rcm_pragmas :: !(Maybe [ConLikeSet]) + -- ^ The residual sets for /all/ COMPLETE sets from pragmas that are + -- visible when compiling this module. Querying that set with + -- 'dsGetCompleteMatches' requires 'DsM', so we initialise it with 'Nothing' + -- until first needed in a 'DsM' context. + } --- | A data type caching the results of 'completeMatchConLikes' with support for --- deletion of constructors that were already matched on. -data PossibleMatches - = PM (NonEmpty.NonEmpty ConLikeSet) - -- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE set - -- 'NonEmpty' because the empty case would mean that the type has no COMPLETE - -- set at all, for which we have 'NoPM'. - | NoPM - -- ^ No COMPLETE set for this type (yet). Think of overloaded literals. +getRcm :: ResidualCompleteMatches -> [ConLikeSet] +getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas -instance Outputable PossibleMatches where - ppr (PM cs) = ppr (NonEmpty.toList cs) - ppr NoPM = text "" +instance Outputable ResidualCompleteMatches where + -- formats as "[{Nothing,Just},{P,Q}]" + ppr rcm = ppr (getRcm rcm) -- | Either @Indirect x@, meaning the value is represented by that of @x@, or -- an @Entry@ containing containing the actual value it represents. @@ -516,8 +527,8 @@ data TmState -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". --- Also caches the type ('vi_ty'), the 'PossibleMatches' of a COMPLETE set --- ('vi_cache'). +-- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set +-- ('vi_rcm'). -- -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo @@ -559,7 +570,7 @@ data VarInfo -- * 'IsBot': @x ~ ⊥@ -- * 'IsNotBot': @x ≁ ⊥@ - , vi_cache :: !PossibleMatches + , vi_rcm :: !ResidualCompleteMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of -- possible constructors of each COMPLETE set. So, if it's not in here, we -- can't possibly match on it. Complementary to 'vi_neg'. We still need it ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -38,7 +38,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.IfaceToCore ( tcIfaceDecl, tcIfaceRules, tcIfaceInst, tcIfaceFamInst - , tcIfaceAnnotations, tcIfaceCompleteSigs ) + , tcIfaceAnnotations, tcIfaceCompleteMatches ) import GHC.Driver.Session import GHC.Driver.Backend @@ -479,7 +479,7 @@ loadInterface doc_str mod from ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) ; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface) ; new_eps_anns <- tcIfaceAnnotations (mi_anns iface) - ; new_eps_complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + ; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT", @@ -509,9 +509,7 @@ loadInterface doc_str mod from eps_rule_base = extendRuleBaseList (eps_rule_base eps) new_eps_rules, eps_complete_matches - = extendCompleteMatchMap - (eps_complete_matches eps) - new_eps_complete_sigs, + = eps_complete_matches eps ++ new_eps_complete_matches, eps_inst_env = extendInstEnvList (eps_inst_env eps) new_eps_insts, eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps) @@ -1037,9 +1035,8 @@ initExternalPackageState home_unit eps_fam_inst_env = emptyFamInstEnv, eps_rule_base = mkRuleBase builtinRules', -- Initialise the EPS rule pool with the built-in rules - eps_mod_fam_inst_env - = emptyModuleEnv, - eps_complete_matches = emptyUFM, + eps_mod_fam_inst_env = emptyModuleEnv, + eps_complete_matches = [], eps_ann_env = emptyAnnEnv, eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0 , n_insts_in = 0, n_insts_out = 0 @@ -1181,7 +1178,7 @@ pprModIface iface at ModIface{ mi_final_exts = exts } , ppr (mi_warns iface) , pprTrustInfo (mi_trust iface) , pprTrustPkg (mi_trust_pkg iface) - , vcat (map ppr (mi_complete_sigs iface)) + , vcat (map ppr (mi_complete_matches iface)) , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface)) , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface)) , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface)) ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -57,6 +57,7 @@ import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Name.Env import GHC.Types.Name.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Utils.Error import GHC.Utils.Outputable @@ -220,7 +221,7 @@ mkIface_ hsc_env md_anns = anns, md_types = type_env, md_exports = exports, - md_complete_sigs = complete_sigs } + md_complete_matches = complete_matches } -- NB: notice that mkIface does not look at the bindings -- only at the TypeEnv. The previous Tidy phase has -- put exactly the info into the TypeEnv that we want @@ -256,7 +257,7 @@ mkIface_ hsc_env iface_fam_insts = map famInstToIfaceFamInst fam_insts trust_info = setSafeMode safe_mode annotations = map mkIfaceAnnotation anns - icomplete_sigs = map mkIfaceCompleteSig complete_sigs + icomplete_matches = map mkIfaceCompleteMatch complete_matches ModIface { mi_module = this_mod, @@ -285,7 +286,7 @@ mkIface_ hsc_env mi_hpc = isHpcUsed hpc_info, mi_trust = trust_info, mi_trust_pkg = pkg_trust_req, - mi_complete_sigs = icomplete_sigs, + mi_complete_matches = icomplete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -322,8 +323,9 @@ mkIface_ hsc_env ************************************************************************ -} -mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch -mkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc +mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch +mkIfaceCompleteMatch cls = + IfaceCompleteMatch (map conLikeName (uniqDSetToList cls)) {- ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -324,11 +324,11 @@ data IfaceAnnotation type IfaceAnnTarget = AnnTarget OccName -data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName +newtype IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] instance Outputable IfaceCompleteMatch where - ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls - <+> dcolon <+> ppr ty + ppr (IfaceCompleteMatch cls) = text "COMPLETE" <> colon <+> ppr cls + @@ -2481,8 +2481,8 @@ instance Binary IfaceTyConParent where return $ IfDataInstance ax pr ty instance Binary IfaceCompleteMatch where - put_ bh (IfaceCompleteMatch cs ts) = put_ bh cs >> put_ bh ts - get bh = IfaceCompleteMatch <$> get bh <*> get bh + put_ bh (IfaceCompleteMatch cs) = put_ bh cs + get bh = IfaceCompleteMatch <$> get bh {- @@ -2638,7 +2638,7 @@ instance NFData IfaceConAlt where IfaceLitAlt lit -> lit `seq` () instance NFData IfaceCompleteMatch where - rnf (IfaceCompleteMatch f1 f2) = rnf f1 `seq` rnf f2 + rnf (IfaceCompleteMatch f1) = rnf f1 instance NFData IfaceRule where rnf (IfaceRule f1 f2 f3 f4 f5 f6 f7 f8) = ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -142,7 +142,7 @@ mkBootModDetailsTc hsc_env tcg_patsyns = pat_syns, tcg_insts = insts, tcg_fam_insts = fam_insts, - tcg_complete_matches = complete_sigs, + tcg_complete_matches = complete_matches, tcg_mod = this_mod } = -- This timing isn't terribly useful since the result isn't forced, but @@ -150,13 +150,13 @@ mkBootModDetailsTc hsc_env Err.withTiming dflags (text "CoreTidy"<+>brackets (ppr this_mod)) (const ()) $ - return (ModDetails { md_types = type_env' - , md_insts = insts' - , md_fam_insts = fam_insts - , md_rules = [] - , md_anns = [] - , md_exports = exports - , md_complete_sigs = complete_sigs + return (ModDetails { md_types = type_env' + , md_insts = insts' + , md_fam_insts = fam_insts + , md_rules = [] + , md_anns = [] + , md_exports = exports + , md_complete_matches = complete_matches }) where dflags = hsc_dflags hsc_env @@ -345,22 +345,22 @@ three places this is actioned: -} tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails) -tidyProgram hsc_env (ModGuts { mg_module = mod - , mg_exports = exports - , mg_rdr_env = rdr_env - , mg_tcs = tcs - , mg_insts = cls_insts - , mg_fam_insts = fam_insts - , mg_binds = binds - , mg_patsyns = patsyns - , mg_rules = imp_rules - , mg_anns = anns - , mg_complete_sigs = complete_sigs - , mg_deps = deps - , mg_foreign = foreign_stubs - , mg_foreign_files = foreign_files - , mg_hpc_info = hpc_info - , mg_modBreaks = modBreaks +tidyProgram hsc_env (ModGuts { mg_module = mod + , mg_exports = exports + , mg_rdr_env = rdr_env + , mg_tcs = tcs + , mg_insts = cls_insts + , mg_fam_insts = fam_insts + , mg_binds = binds + , mg_patsyns = patsyns + , mg_rules = imp_rules + , mg_anns = anns + , mg_complete_matches = complete_matches + , mg_deps = deps + , mg_foreign = foreign_stubs + , mg_foreign_files = foreign_files + , mg_hpc_info = hpc_info + , mg_modBreaks = modBreaks }) = Err.withTiming dflags @@ -465,13 +465,13 @@ tidyProgram hsc_env (ModGuts { mg_module = mod cg_modBreaks = modBreaks, cg_spt_entries = spt_entries }, - ModDetails { md_types = tidy_type_env, - md_rules = tidy_rules, - md_insts = tidy_cls_insts, - md_fam_insts = fam_insts, - md_exports = exports, - md_anns = anns, -- are already tidy - md_complete_sigs = complete_sigs + ModDetails { md_types = tidy_type_env, + md_rules = tidy_rules, + md_insts = tidy_cls_insts, + md_fam_insts = fam_insts, + md_exports = exports, + md_anns = anns, -- are already tidy + md_complete_matches = complete_matches }) } where ===================================== compiler/GHC/IfaceToCore.hs ===================================== @@ -17,7 +17,7 @@ module GHC.IfaceToCore ( typecheckIfacesForMerging, typecheckIfaceForInstantiate, tcIfaceDecl, tcIfaceInst, tcIfaceFamInst, tcIfaceRules, - tcIfaceAnnotations, tcIfaceCompleteSigs, + tcIfaceAnnotations, tcIfaceCompleteMatches, tcIfaceExpr, -- Desired by HERMIT (#7683) tcIfaceGlobal, tcIfaceOneShot @@ -67,6 +67,7 @@ import GHC.Types.Name.Set import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr ) import GHC.Unit.Module import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet ( mkUniqDSet ) import GHC.Types.Unique.Supply import GHC.Utils.Outputable import GHC.Data.Maybe @@ -179,7 +180,7 @@ typecheckIface iface ; exports <- ifaceExportNames (mi_exports iface) -- Complete Sigs - ; complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + ; complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) -- Finished ; traceIf (vcat [text "Finished typechecking interface for" <+> ppr (mi_module iface), @@ -193,7 +194,7 @@ typecheckIface iface , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } } @@ -392,14 +393,14 @@ typecheckIfacesForMerging mod ifaces tc_env_var = rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) exports <- ifaceExportNames (mi_exports iface) - complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) return $ ModDetails { md_types = type_env , md_insts = insts , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } return (global_type_env, details) @@ -431,14 +432,14 @@ typecheckIfaceForInstantiate nsubst iface = rules <- tcIfaceRules ignore_prags (mi_rules iface) anns <- tcIfaceAnnotations (mi_anns iface) exports <- ifaceExportNames (mi_exports iface) - complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) return $ ModDetails { md_types = type_env , md_insts = insts , md_fam_insts = fam_insts , md_rules = rules , md_anns = anns , md_exports = exports - , md_complete_sigs = complete_sigs + , md_complete_matches = complete_matches } -- Note [Resolving never-exported Names] @@ -1146,11 +1147,14 @@ tcIfaceAnnTarget (ModuleTarget mod) = do ************************************************************************ -} -tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch] -tcIfaceCompleteSigs = mapM tcIfaceCompleteSig +tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch] +tcIfaceCompleteMatches = mapM tcIfaceCompleteMatch -tcIfaceCompleteSig :: IfaceCompleteMatch -> IfL CompleteMatch -tcIfaceCompleteSig (IfaceCompleteMatch ms t) = return (CompleteMatch ms t) +tcIfaceCompleteMatch :: IfaceCompleteMatch -> IfL CompleteMatch +tcIfaceCompleteMatch (IfaceCompleteMatch ms) = + mkUniqDSet <$> mapM (forkM doc . tcIfaceConLike) ms + where + doc = text "COMPLETE sig" <+> ppr ms {- ************************************************************************ @@ -1759,7 +1763,13 @@ tcIfaceDataCon :: Name -> IfL DataCon tcIfaceDataCon name = do { thing <- tcIfaceGlobal name ; case thing of AConLike (RealDataCon dc) -> return dc - _ -> pprPanic "tcIfaceExtDC" (ppr name$$ ppr thing) } + _ -> pprPanic "tcIfaceDataCon" (ppr name$$ ppr thing) } + +tcIfaceConLike :: Name -> IfL ConLike +tcIfaceConLike name = do { thing <- tcIfaceGlobal name + ; case thing of + AConLike cl -> return cl + _ -> pprPanic "tcIfaceConLike" (ppr name$$ ppr thing) } tcIfaceExtId :: Name -> IfL Id tcIfaceExtId name = do { thing <- tcIfaceGlobal name ===================================== compiler/GHC/IfaceToCore.hs-boot ===================================== @@ -11,9 +11,9 @@ import GHC.Core ( CoreRule ) import GHC.Driver.Types ( CompleteMatch ) import GHC.Types.Annotations ( Annotation ) -tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing -tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] -tcIfaceInst :: IfaceClsInst -> IfL ClsInst -tcIfaceFamInst :: IfaceFamInst -> IfL FamInst -tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] -tcIfaceCompleteSigs :: [IfaceCompleteMatch] -> IfL [CompleteMatch] +tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing +tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule] +tcIfaceInst :: IfaceClsInst -> IfL ClsInst +tcIfaceFamInst :: IfaceFamInst -> IfL FamInst +tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation] +tcIfaceCompleteMatches :: [IfaceCompleteMatch] -> IfL [CompleteMatch] ===================================== compiler/GHC/Tc/Gen/Bind.hs ===================================== @@ -44,9 +44,8 @@ import GHC.Tc.Utils.TcMType import GHC.Core.Multiplicity import GHC.Core.FamInstEnv( normaliseType ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs ) -import GHC.Core.TyCon import GHC.Tc.Utils.TcType -import GHC.Core.Type (mkStrLitTy, tidyOpenType, splitTyConApp_maybe, mkCastTy) +import GHC.Core.Type (mkStrLitTy, tidyOpenType, mkCastTy) import GHC.Builtin.Types.Prim import GHC.Builtin.Types( mkBoxedTupleTy ) import GHC.Types.Id @@ -69,9 +68,9 @@ import GHC.Utils.Panic import GHC.Builtin.Names( ipClassName ) import GHC.Tc.Validity (checkValidType) import GHC.Types.Unique.FM +import GHC.Types.Unique.DSet import GHC.Types.Unique.Set import qualified GHC.LanguageExtensions as LangExt -import GHC.Core.ConLike import Control.Monad import Data.Foldable (find) @@ -197,112 +196,22 @@ tcTopBinds binds sigs -- The top level bindings are flattened into a giant -- implicitly-mutually-recursive LHsBinds - --- Note [Typechecking Complete Matches] --- Much like when a user bundled a pattern synonym, the result types of --- all the constructors in the match pragma must be consistent. --- --- If we allowed pragmas with inconsistent types then it would be --- impossible to ever match every constructor in the list and so --- the pragma would be useless. - - - - - --- This is only used in `tcCompleteSig`. We fold over all the conlikes, --- this accumulator keeps track of the first `ConLike` with a concrete --- return type. After fixing the return type, all other constructors with --- a fixed return type must agree with this. --- --- The fields of `Fixed` cache the first conlike and its return type so --- that we can compare all the other conlikes to it. The conlike is --- stored for error messages. --- --- `Nothing` in the case that the type is fixed by a type signature -data CompleteSigType = AcceptAny | Fixed (Maybe ConLike) TyCon - tcCompleteSigs :: [LSig GhcRn] -> TcM [CompleteMatch] tcCompleteSigs sigs = let - doOne :: Sig GhcRn -> TcM (Maybe CompleteMatch) - doOne c@(CompleteMatchSig _ _ lns mtc) - = fmap Just $ do - addErrCtxt (text "In" <+> ppr c) $ - case mtc of - Nothing -> infer_complete_match - Just tc -> check_complete_match tc - where - - checkCLTypes acc = foldM checkCLType (acc, []) (unLoc lns) - - infer_complete_match = do - (res, cls) <- checkCLTypes AcceptAny - case res of - AcceptAny -> failWithTc ambiguousError - Fixed _ tc -> return $ mkMatch cls tc - - check_complete_match tc_name = do - ty_con <- tcLookupLocatedTyCon tc_name - (_, cls) <- checkCLTypes (Fixed Nothing ty_con) - return $ mkMatch cls ty_con - - mkMatch :: [ConLike] -> TyCon -> CompleteMatch - mkMatch cls ty_con = CompleteMatch { - -- foldM is a left-fold and will have accumulated the ConLikes in - -- the reverse order. foldrM would accumulate in the correct order, - -- but would type-check the last ConLike first, which might also be - -- confusing from the user's perspective. Hence reverse here. - completeMatchConLikes = reverse (map conLikeName cls), - completeMatchTyCon = tyConName ty_con - } + doOne :: LSig GhcRn -> TcM (Maybe CompleteMatch) + -- We don't need to "type-check" COMPLETE signatures anymore; if their + -- combinations are invalid it will be found so at match sites. Hence we + -- keep '_mtc' only for backwards compatibility. + doOne (L loc c@(CompleteMatchSig _ext _src_txt (L _ ns) _mtc)) + = fmap Just $ setSrcSpan loc $ addErrCtxt (text "In" <+> ppr c) $ + mkUniqDSet <$> mapM (addLocM tcLookupConLike) ns doOne _ = return Nothing - ambiguousError :: SDoc - ambiguousError = - text "A type signature must be provided for a set of polymorphic" - <+> text "pattern synonyms." - - - -- See note [Typechecking Complete Matches] - checkCLType :: (CompleteSigType, [ConLike]) -> Located Name - -> TcM (CompleteSigType, [ConLike]) - checkCLType (cst, cs) n = do - cl <- addLocM tcLookupConLike n - let (_,_,_,_,_,_, res_ty) = conLikeFullSig cl - res_ty_con = fst <$> splitTyConApp_maybe res_ty - case (cst, res_ty_con) of - (AcceptAny, Nothing) -> return (AcceptAny, cl:cs) - (AcceptAny, Just tc) -> return (Fixed (Just cl) tc, cl:cs) - (Fixed mfcl tc, Nothing) -> return (Fixed mfcl tc, cl:cs) - (Fixed mfcl tc, Just tc') -> - if tc == tc' - then return (Fixed mfcl tc, cl:cs) - else case mfcl of - Nothing -> - addErrCtxt (text "In" <+> ppr cl) $ - failWithTc typeSigErrMsg - Just cl -> failWithTc (errMsg cl) - where - typeSigErrMsg :: SDoc - typeSigErrMsg = - text "Couldn't match expected type" - <+> quotes (ppr tc) - <+> text "with" - <+> quotes (ppr tc') - - errMsg :: ConLike -> SDoc - errMsg fcl = - text "Cannot form a group of complete patterns from patterns" - <+> quotes (ppr fcl) <+> text "and" <+> quotes (ppr cl) - <+> text "as they match different type constructors" - <+> parens (quotes (ppr tc) - <+> text "resp." - <+> quotes (ppr tc')) -- For some reason I haven't investigated further, the signatures come in -- backwards wrt. declaration order. So we reverse them here, because it makes -- a difference for incomplete match suggestions. - in mapMaybeM (addLocM doOne) (reverse sigs) -- process in declaration order + in mapMaybeM doOne $ reverse sigs tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id] -- A hs-boot file has only one BindGroup, and it only has type ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -45,12 +45,11 @@ module GHC.Tc.Types( IdBindingInfo(..), ClosedTypeId, RhsNames, IsGroupClosed(..), SelfBootInfo(..), - pprTcTyThingCategory, pprPECategory, CompleteMatch(..), + pprTcTyThingCategory, pprPECategory, CompleteMatch, -- Desugaring types DsM, DsLclEnv(..), DsGblEnv(..), - DsMetaEnv, DsMetaVal(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap, + DsMetaEnv, DsMetaVal(..), CompleteMatches, -- Template Haskell ThStage(..), SpliceType(..), PendingStuff(..), @@ -310,7 +309,7 @@ data DsGblEnv , ds_msgs :: IORef Messages -- Warning messages , ds_if_env :: (IfGblEnv, IfLclEnv) -- Used for looking up global, -- possibly-imported things - , ds_complete_matches :: CompleteMatchMap + , ds_complete_matches :: CompleteMatches -- Additional complete pattern matches , ds_cc_st :: IORef CostCentreState -- Tracking indices for cost centre annotations @@ -602,7 +601,7 @@ data TcGblEnv tcg_static_wc :: TcRef WantedConstraints, -- ^ Wanted constraints of static forms. -- See Note [Constraints in static forms]. - tcg_complete_matches :: [CompleteMatch], + tcg_complete_matches :: !CompleteMatches, -- ^ Tracking indices for cost centre annotations tcg_cc_st :: TcRef CostCentreState ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -64,8 +64,8 @@ module GHC.Tc.Utils.Env( topIdLvl, isBrackStage, -- New Ids - newDFunName, newFamInstTyConName, - newFamInstAxiomName, + newDFunName, + newFamInstTyConName, newFamInstAxiomName, mkStableIdFromString, mkStableIdFromName, mkWrapperName ) where ===================================== docs/users_guide/exts/pragmas.rst ===================================== @@ -887,29 +887,6 @@ modules. ``COMPLETE`` pragmas should be thought of as asserting a universal truth about a set of patterns and as a result, should not be used to silence context specific incomplete match warnings. -When specifying a ``COMPLETE`` pragma, the result types of all patterns must -be consistent with each other. This is a sanity check as it would be impossible -to match on all the patterns if the types were inconsistent. - -The result type must also be unambiguous. Usually this can be inferred but -when all the pattern synonyms in a group are polymorphic in the constructor -the user must provide a type signature. :: - - class LL f where - go :: f a -> () - - instance LL [] where - go _ = () - - pattern T :: LL f => f a - pattern T <- (go -> ()) - - {-# COMPLETE T :: [] #-} - - -- No warning - foo :: [a] -> Int - foo T = 5 - .. _overlap-pragma: ``OVERLAPPING``, ``OVERLAPPABLE``, ``OVERLAPS``, and ``INCOHERENT`` pragmas ===================================== testsuite/tests/pmcheck/complete_sigs/completesig15.hs → testsuite/tests/pmcheck/complete_sigs/T14422.hs ===================================== @@ -10,3 +10,6 @@ pattern P :: C f => f a pattern P <- (foo -> ()) {-# COMPLETE P #-} + +f :: C f => f a -> () +f P = () -- A complete match ===================================== testsuite/tests/pmcheck/complete_sigs/T18277.hs ===================================== @@ -0,0 +1,13 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE PatternSynonyms #-} + +module Lib where + +type List = [] + +pattern DefinitelyAString :: String -> String +pattern DefinitelyAString x = x +{-# COMPLETE DefinitelyAString #-} + +f :: String -> String +f (DefinitelyAString x) = x ===================================== testsuite/tests/pmcheck/complete_sigs/all.T ===================================== @@ -1,7 +1,7 @@ test('completesig01', normal, compile, ['']) test('completesig02', normal, compile, ['']) test('Completesig03', normal, multimod_compile, ['Completesig03', '-Wall']) -test('completesig04', normal, compile_fail, ['']) +test('completesig04', normal, compile, ['-Wincomplete-patterns']) test('completesig05', normal, compile, ['']) test('completesig06', normal, compile, ['']) test('completesig07', normal, compile, ['']) @@ -12,7 +12,6 @@ test('completesig11', normal, compile, ['']) test('completesig12', normal, compile, ['']) test('completesig13', normal, compile, ['']) test('completesig14', normal, compile, ['']) -test('completesig15', normal, compile_fail, ['']) test('T13021', normal, compile, ['']) test('T13363a', normal, compile, ['']) test('T13363b', normal, compile, ['']) @@ -22,6 +21,8 @@ test('T13965', normal, compile, ['']) test('T14059a', normal, compile, ['']) test('T14059b', expect_broken('14059'), compile, ['']) test('T14253', normal, compile, ['']) +test('T14422', normal, compile, ['']) test('T14851', normal, compile, ['']) test('T17149', normal, compile, ['']) test('T17386', normal, compile, ['']) +test('T18277', normal, compile, ['']) ===================================== testsuite/tests/pmcheck/complete_sigs/completesig04.hs ===================================== @@ -1,6 +1,12 @@ --- Test that a COMPLETE pragma over constructors of different types fails. +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +-- Test that a COMPLETE pragma over constructors of different types is a valid +-- declaration, but that it's not suggested in any warning. module TyMismatch where -data E = L | R +data T = A | B | C -{-# COMPLETE Just, L #-} +{-# COMPLETE Just, A #-} + +f A = () -- should not suggest 'Just' + +g (Just _) = () -- should not suggest 'A' ===================================== testsuite/tests/pmcheck/complete_sigs/completesig04.stderr ===================================== @@ -1,4 +1,11 @@ -completesig04.hs:6:1: error: - • Cannot form a group of complete patterns from patterns ‘Just’ and ‘L’ as they match different type constructors (‘Maybe’ resp. ‘E’) - • In {-# COMPLETE Just, L #-} +completesig04.hs:10:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: + Patterns not matched: + B + C + +completesig04.hs:12:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘g’: Patterns not matched: Nothing ===================================== testsuite/tests/pmcheck/complete_sigs/completesig15.stderr deleted ===================================== @@ -1,4 +0,0 @@ - -completesig15.hs:12:1: error: - • A type signature must be provided for a set of polymorphic pattern synonyms. - • In {-# COMPLETE P #-} ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -88,7 +88,7 @@ test('T17112', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17207', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17207b', expect_broken(17207), compile, +test('T17207b', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17208', expect_broken(17208), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ebb3f815dc84adfefb0198ebc6dc12ec7bbc147f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ebb3f815dc84adfefb0198ebc6dc12ec7bbc147f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 13:26:55 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Thu, 10 Sep 2020 09:26:55 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/rts-signal-stack Message-ID: <5f5a299f48ca5_80b3f8492a87d74114090c5@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/rts-signal-stack at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/rts-signal-stack You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 13:40:22 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 09:40:22 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 7 commits: base: Use keepAlive# in alloca, et al. Message-ID: <5f5a2cc691a94_80b1015226811412668@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: 36863ab9 by Ben Gamari at 2020-09-10T13:40:16+00:00 base: Use keepAlive# in alloca, et al. - - - - - d7b151c5 by GHC GitLab CI at 2020-09-10T13:40:16+00:00 Simplify: Factor out runRW rule - - - - - c193ca0f by GHC GitLab CI at 2020-09-10T13:40:16+00:00 Simplify - - - - - b1d535d2 by GHC GitLab CI at 2020-09-10T13:40:16+00:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #17983. - - - - - bed62e4c by Ben Gamari at 2020-09-10T13:40:16+00:00 base: Use keepAlive# in withForeignPtr - - - - - ab8630e0 by GHC GitLab CI at 2020-09-10T13:40:16+00:00 base: Make touchForeignPtr more robust Previously touchForeignPtr would touch the ForeignPtr's associated ForeignPtrContents. However, this is a normal constructor and therefore can be eliminated by the simplifier. To ensure that the foreign pointer's contents isn't dropped we need to rather `touch#` the underlying array (which is the same thing that we key the `Weak` on when adding finalizers). - - - - - 22837c60 by GHC GitLab CI at 2020-09-10T13:40:16+00:00 base: Make ForeignPtrContents of ForeignPtr strict As mentioned in #17290, there are strong benefits to the `ForeignPtrContents` field of `ForeignPtr` being strict. In particular, when looking at the reproducer for #17746, I noticed that the `ForeignPtrContents` was being allocated on every call to `withForeignPtr` just to be `touch#`'d'. This is a pretty large overhead for something like `withForeignPtr` that should be free. This required updating the `bytestring` submodule to avoid a bottoming `ForeignPtrContents` in `Data.ByteString.Internal` Fixes #17290. - - - - - 8 changed files: - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/CoreToStg/Prep.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Target.hs - libraries/base/Foreign/ForeignPtr/Imp.hs - libraries/base/Foreign/Marshal/Alloc.hs - libraries/base/GHC/ForeignPtr.hs - libraries/bytestring Changes: ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -68,7 +68,7 @@ import GHC.Utils.Misc import GHC.Utils.Error import GHC.Unit.Module ( moduleName, pprModuleName ) import GHC.Core.Multiplicity -import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) +import GHC.Builtin.PrimOps ( PrimOp (SeqOp, KeepAliveOp) ) {- @@ -1975,29 +1975,9 @@ rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_c = rebuildCall env (addTyArgTo info arg_ty hole_ty) cont ---------- The runRW# rule. Do this after absorbing all arguments ------ --- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep. --- --- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o --- K[ runRW# rr ty body ] --> runRW rr' ty' (\s. K[ body s ]) -rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) - (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_hole_ty = fun_ty }) - | fun_id `hasKey` runRWKey - , not (contIsStop cont) -- Don't fiddle around if the continuation is boring - , [ TyArg {}, TyArg {} ] <- rev_args - = do { s <- newId (fsLit "s") Many realWorldStatePrimTy - ; let (m,_,_) = splitFunTy fun_ty - env' = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s] - ty' = contResultType cont - cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s - , sc_env = env', sc_cont = cont - , sc_hole_ty = mkVisFunTy m realWorldStatePrimTy ty' } - -- cont' applies to s, then K - ; body' <- simplExprC env' arg cont' - ; let arg' = Lam s body' - rr' = getRuntimeRep ty' - call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg ty', arg'] - ; return (emptyFloats env, call') } +rebuildCall env arg_info cont + | Just do_it <- rebuildContOpCall env arg_info cont + = do_it rebuildCall env fun_info (ApplyToVal { sc_arg = arg, sc_env = arg_se @@ -2034,6 +2014,87 @@ rebuildCall env fun_info rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont = rebuild env (argInfoExpr fun rev_args) cont +-- | Simplifications of runRW# and keepAlive# +rebuildContOpCall :: SimplEnv -> ArgInfo -> SimplCont -> Maybe (SimplM (SimplFloats, OutExpr)) +rebuildContOpCall _env _arg_info cont + | not (contIsStop cont) -- Don't fiddle around if the continuation is boring + = Nothing + +-- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep. +-- +-- N.B. runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). +-- (State# RealWorld -> o) -> o +-- +-- K[ runRW# rr ty body ] +-- ~> +-- runRW rr' ty' (\s. K[ body s ]) +rebuildContOpCall + env + (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) + (ApplyToVal { sc_arg = arg, sc_env = arg_se + , sc_cont = cont, sc_hole_ty = fun_ty }) + | fun_id `hasKey` runRWKey + , [ TyArg {}, TyArg {} ] <- rev_args + = Just $ + do { s <- newId (fsLit "s") Many realWorldStatePrimTy + ; let (m,_,_) = splitFunTy fun_ty + env' = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s] + ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' + cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s + , sc_env = env', sc_cont = cont + , sc_hole_ty = k'_ty } + -- cont' applies to s, then K + ; body' <- simplExprC env' arg cont' + ; let arg' = Lam s body' + rr' = getRuntimeRep ty' + call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg ty', arg'] + ; return (emptyFloats env, call') } + +-- See Note [Simplification of keepAlive#] in GHC.CoreToStg.Prep. +-- +-- K[keepAlive# @a_rep @a @r_rep @r x s k] +-- ~> +-- keepAlive# @a_rep @a @r_rep @r x s K[k] +rebuildContOpCall + env + (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) + (ApplyToVal { sc_arg = k, sc_env = k_se + , sc_cont = cont, sc_hole_ty = fun_ty }) + | Just KeepAliveOp <- isPrimOpId_maybe fun_id + , [ ValArg {as_arg=s0} + , ValArg {as_arg=x} + , TyArg {} -- res_ty + , TyArg {} -- res_rep + , TyArg {as_arg_ty=arg_ty} + , TyArg {as_arg_ty=arg_rep} + ] <- rev_args + = Just $ + do { s <- newId (fsLit "s") One realWorldStatePrimTy + ; let (m,_,_) = splitFunTy fun_ty + k_env = (k_se `setInScopeFromE` env) `addNewInScopeIds` [s] + ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' + k_cont = ApplyToVal { sc_dup = Simplified, sc_arg = Var s + , sc_env = k_env, sc_cont = cont + , sc_hole_ty = k'_ty } + ; k' <- simplExprC k_env k k_cont + ; let env' = zapSubstEnv env + ; s0' <- simplExpr env' s0 + ; x' <- simplExpr env' x + ; arg_rep' <- simplType env' arg_rep + ; arg_ty' <- simplType env' arg_ty + ; let call' = mkApps (Var fun_id) + [ mkTyArg arg_rep', mkTyArg arg_ty' + , mkTyArg (getRuntimeRep ty'), mkTyArg ty' + , x' + , s0' + , Lam s k' + ] + ; return (emptyFloats env, call') } + +rebuildContOpCall _ _ _ = Nothing + {- Note [Trying rewrite rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider an application (f e1 e2 e3) where the e1,e2,e3 are not yet ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1096,10 +1096,26 @@ Breaking our desired invariant. Ultimately we decided to simply accept that the continuation may not be a manifest lambda. +Note [Simplification of keepAlive#] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The keepAlive# primop benefits from a similar optimisation to that described in +Note [Simplification of runRW#] above. Specifically, we transform: + + K[keepAlive# @a_rep @a @r_rep @r x s k] + ~> + keepAlive# @a_rep @a @r_rep @r x s K[k] + +The reasons are similar to those described in Note [Simplification of runRW#]. + +-} + + -- --------------------------------------------------------------------------- -- CpeArg: produces a result satisfying CpeArg -- --------------------------------------------------------------------------- +{- Note [ANF-ising literal string arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -35,6 +35,9 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do hasDynamic = elem dynamic ways mconcat [ arg "-Wall" , not useColor ? builder (Ghc CompileHs) ? + -- N.B. Target.trackArgument ignores this argument from the + -- input hash to avoid superfluous recompilation, avoiding + -- #18672. arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? ===================================== hadrian/src/Target.hs ===================================== @@ -21,11 +21,12 @@ type Target = H.Target Context Builder trackArgument :: Target -> String -> Bool trackArgument target arg = case builder target of Make _ -> not $ threadArg arg - Ghc _ _ -> not $ verbosityArg arg + Ghc _ _ -> not $ verbosityArg arg || diagnosticsColorArg arg Cabal _ _ -> not $ verbosityArg arg || cabal_configure_ignore arg _ -> True where threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="] verbosityArg s = dropWhileEnd isDigit s == "-v" + diagnosticsColorArg s = "-fdiagnostics-color=" `isPrefixOf` s -- N.B. #18672 cabal_configure_ignore s = s `elem` [ "--configure-option=--quiet", "--configure-option=--disable-option-checking" ] ===================================== libraries/base/Foreign/ForeignPtr/Imp.hs ===================================== @@ -66,31 +66,6 @@ newForeignPtr finalizer p addForeignPtrFinalizer finalizer fObj return fObj -withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b --- ^This is a way to look at the pointer living inside a --- foreign object. This function takes a function which is --- applied to that pointer. The resulting 'IO' action is then --- executed. The foreign object is kept alive at least during --- the whole action, even if it is not used directly --- inside. Note that it is not safe to return the pointer from --- the action and use it after the action completes. All uses --- of the pointer should be inside the --- 'withForeignPtr' bracket. The reason for --- this unsafeness is the same as for --- 'unsafeForeignPtrToPtr' below: the finalizer --- may run earlier than expected, because the compiler can only --- track usage of the 'ForeignPtr' object, not --- a 'Ptr' object made from it. --- --- This function is normally used for marshalling data to --- or from the object pointed to by the --- 'ForeignPtr', using the operations from the --- 'Storable' class. -withForeignPtr fo io - = do r <- io (unsafeForeignPtrToPtr fo) - touchForeignPtr fo - return r - -- | This variant of 'newForeignPtr' adds a finalizer that expects an -- environment in addition to the finalized pointer. The environment -- that will be passed to the finalizer is fixed by the second argument to ===================================== libraries/base/Foreign/Marshal/Alloc.hs ===================================== @@ -116,19 +116,6 @@ alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b alloca = allocaBytesAligned (sizeOf (undefined :: a)) (alignment (undefined :: a)) --- Note [NOINLINE for touch#] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously --- fragile in the presence of simplification (see #14346). In particular, the --- simplifier may drop the continuation containing the touch# if it can prove --- that the action passed to allocaBytes will not return. The hack introduced to --- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the --- simplifier can't see the divergence. --- --- These can be removed once #14375 is fixed, which suggests that we instead do --- away with touch# in favor of a primitive that will capture the scoping left --- implicit in the case of touch#. - -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory of @n@ bytes. -- The block of memory is sufficiently aligned for any of the basic @@ -142,13 +129,9 @@ allocaBytes (I# size) action = IO $ \ s0 -> case newPinnedByteArray# size s0 of { (# s1, mbarr# #) -> case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) -> let addr = Ptr (byteArrayContents# barr#) in - case action addr of { IO action' -> - case action' s2 of { (# s3, r #) -> - case touch# barr# s3 of { s4 -> - (# s4, r #) - }}}}} --- See Note [NOINLINE for touch#] -{-# NOINLINE allocaBytes #-} + case action addr of { IO action' -> + keepAlive# barr# s2 action' + }}} allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> @@ -156,12 +139,8 @@ allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) -> let addr = Ptr (byteArrayContents# barr#) in case action addr of { IO action' -> - case action' s2 of { (# s3, r #) -> - case touch# barr# s3 of { s4 -> - (# s4, r #) - }}}}} --- See Note [NOINLINE for touch#] -{-# NOINLINE allocaBytesAligned #-} + keepAlive# barr# s2 action' + }}} -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b at . The returned pointer ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -3,6 +3,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} {-# OPTIONS_HADDOCK not-home #-} @@ -46,6 +48,7 @@ module GHC.ForeignPtr castForeignPtr, plusForeignPtr, -- * Finalization + withForeignPtr, touchForeignPtr, finalizeForeignPtr -- * Commentary @@ -55,6 +58,7 @@ module GHC.ForeignPtr import Foreign.Storable import Data.Foldable ( sequence_ ) +import GHC.Types import GHC.Show import GHC.Base import GHC.IORef @@ -79,7 +83,7 @@ import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) -- type argument of 'ForeignPtr' should normally be an instance of -- class 'Storable'. -- -data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents +data ForeignPtr a = ForeignPtr Addr# !ForeignPtrContents -- The Addr# in the ForeignPtr object is intentionally stored -- separately from the finalizer. The primary aim of the -- representation is to make withForeignPtr efficient; in fact, @@ -124,7 +128,7 @@ data ForeignPtrContents -- ^ The pointer refers to unmanaged memory that should not be freed when -- the 'ForeignPtr' becomes unreachable. Functions that add finalizers -- to a 'ForeignPtr' throw exceptions when the 'ForeignPtr' is backed by - -- 'PlainPtr'Most commonly, this is used with @Addr#@ literals. + -- 'PlainPtr'. Most commonly, this is used with @Addr#@ literals. -- See Note [Why FinalPtr]. -- -- @since 4.15 @@ -162,6 +166,7 @@ data ForeignPtrContents -- The invariants that apply to 'MallocPtr' apply to 'PlainPtr' as well. -- Note [Why FinalPtr] +-- ~~~~~~~~~~~~~~~~~~~ -- -- FinalPtr exists as an optimization for foreign pointers created -- from Addr# literals. Most commonly, this happens in the bytestring @@ -428,7 +433,7 @@ addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do else return () where finalizer' :: State# RealWorld -> (# State# RealWorld, () #) - finalizer' = unIO (foreignPtrFinalizer r >> touch f) + finalizer' = unIO (foreignPtrFinalizer r >> touchForeignPtrContents f) addForeignPtrConcFinalizer_ _ _ = errorWithoutStackTrace "GHC.ForeignPtr: attempt to add a finalizer to plain pointer or a final pointer" @@ -503,6 +508,36 @@ newForeignPtr_ (Ptr obj) = do r <- newIORef NoFinalizers return (ForeignPtr obj (PlainForeignPtr r)) +withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +-- ^This is a way to look at the pointer living inside a +-- foreign object. This function takes a function which is +-- applied to that pointer. The resulting 'IO' action is then +-- executed. The foreign object is kept alive at least during +-- the whole action, even if it is not used directly +-- inside. Note that it is not safe to return the pointer from +-- the action and use it after the action completes. All uses +-- of the pointer should be inside the +-- 'withForeignPtr' bracket. The reason for +-- this unsafeness is the same as for +-- 'unsafeForeignPtrToPtr' below: the finalizer +-- may run earlier than expected, because the compiler can only +-- track usage of the 'ForeignPtr' object, not +-- a 'Ptr' object made from it. +-- +-- This function is normally used for marshalling data to +-- or from the object pointed to by the +-- 'ForeignPtr', using the operations from the +-- 'Storable' class. +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> + case f (unsafeForeignPtrToPtr fo) of + IO action# -> + case r of + PlainForeignPtr ref -> keepAlive# ref s action# + FinalPtr -> action# s + MallocPtr mba _ -> keepAlive# mba s action# + PlainPtr mba -> keepAlive# mba s action# + + touchForeignPtr :: ForeignPtr a -> IO () -- ^This function ensures that the foreign object in -- question is alive at the given place in the sequence of IO @@ -528,10 +563,19 @@ touchForeignPtr :: ForeignPtr a -> IO () -- result in artificial deadlock. Another alternative is to use -- explicit reference counting. -- -touchForeignPtr (ForeignPtr _ r) = touch r +touchForeignPtr (ForeignPtr _ r) = touchForeignPtrContents r + +touchForeignPtrContents :: ForeignPtrContents -> IO () +touchForeignPtrContents (PlainForeignPtr ref) = touchLifted ref +touchForeignPtrContents FinalPtr = return () +touchForeignPtrContents (MallocPtr mba _) = touchUnlifted mba +touchForeignPtrContents (PlainPtr mba) = touchUnlifted mba + +touchLifted :: a -> IO () +touchLifted r = IO $ \s -> case touch# r s of s' -> (# s', () #) -touch :: ForeignPtrContents -> IO () -touch r = IO $ \s -> case touch# r s of s' -> (# s', () #) +touchUnlifted :: forall (a :: TYPE 'UnliftedRep). a -> IO () +touchUnlifted r = IO $ \s -> case touch# r s of s' -> (# s', () #) unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a -- ^This function extracts the pointer component of a foreign ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit e6cb01e2ec0bfdd19298418c85f220925a9fa307 +Subproject commit ee9f5fcf533b283f321f2b121684df77f1bcc825 View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86888d093a16f8fe9ef7cff0d8b24b12619e3180...22837c607d7388c8117bdffbccd19bb77f0861d2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/86888d093a16f8fe9ef7cff0d8b24b12619e3180...22837c607d7388c8117bdffbccd19bb77f0861d2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 14:01:40 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 10 Sep 2020 10:01:40 -0400 Subject: [Git][ghc/ghc][wip/T18645] 45 commits: Fix FastString lexicographic ordering (fix #18562) Message-ID: <5f5a31c428b93_80b3f8446ea577c114146c@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 at Glasgow Haskell Compiler / GHC Commits: 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - f45c0591 by Sebastian Graf at 2020-09-09T17:20:40+02:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - cf1aa1ae by Sebastian Graf at 2020-09-09T18:24:23+02:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 6eafc6d7 by Sebastian Graf at 2020-09-09T18:27:48+02:00 .gitignore *.hiedb files - - - - - 592d57ee by Sebastian Graf at 2020-09-09T18:32:51+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - ebb3f815 by Sebastian Graf at 2020-09-10T14:32:05+02:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 30a0e389 by Sebastian Graf at 2020-09-10T16:01:32+02:00 Make `tcCheckSatisfiability` incremental (#18645) By taking and returning an `InertSet`. Every new `TcS` session can then pick up where a prior session left with `setTcSInerts`. Since we don't want to unflatten the Givens (and because it leads to infinite loops, see !3971), we introduced a new variant of `runTcS`, `runTcSInerts`, that takes and returns the `InertSet` and makes sure not to unflatten the Givens after running the `TcS` action. Fixes #18645 and #17836. Metric Decrease: T17977 - - - - - be49d7f9 by Sebastian Graf at 2020-09-10T16:01:32+02:00 Extract definition of DsM into GHC.HsToCore.Types `DsM` was previously defined in `GHC.Tc.Types`, along with `TcM`. But `GHC.Tc.Types` is in the set of transitive dependencies of `GHC.Parser`, a set which we aim to minimise. Test case `CountParserDeps` checks for that. Having `DsM` in that set means the parser also depends on the innards of the pattern-match checker in `GHC.HsToCore.PmCheck.Types`, which is the reason we have that module in the first place. In the previous commit, we represented the `TyState` by an `InertSet`, but that pulls the constraint solver as well as 250 more modules into the set of dependencies, triggering failure of `CountParserDeps`. Clearly, we want to evolve the pattern-match checker (and the desugarer) without being concerned by this test, so this patch includes a small refactor that puts `DsM` into its own module. - - - - - 1f29a97f by Sebastian Graf at 2020-09-10T16:01:32+02:00 Hackily decouple the parser from the desugarer In a hopefully temporary hack, I re-used the idea from !1957 of using a nullary type family to break the dependency from GHC.Driver.Hooks on the definition of DsM ("Abstract Data"). This in turn broke the last dependency from the parser to the desugarer. More details in `Note [The Decoupling Abstract Data Hack]`. In the future, we hope to undo this hack again in favour of breaking the dependency from the parser to DynFlags altogether. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Rules.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e8f5cf01892647498afe53fe4311d06633c5bafd...1f29a97ff3c38685c56a2c516fae3f57fcab31b9 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e8f5cf01892647498afe53fe4311d06633c5bafd...1f29a97ff3c38685c56a2c516fae3f57fcab31b9 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 14:04:59 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 10 Sep 2020 10:04:59 -0400 Subject: [Git][ghc/ghc][wip/T18645] Hackily decouple the parser from the desugarer Message-ID: <5f5a328b28166_80b102c102c1141519c@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18645 at Glasgow Haskell Compiler / GHC Commits: 9280042c by Sebastian Graf at 2020-09-10T16:04:51+02:00 Hackily decouple the parser from the desugarer In a hopefully temporary hack, I re-used the idea from !1957 of using a nullary type family to break the dependency from GHC.Driver.Hooks on the definition of DsM ("Abstract Data"). This in turn broke the last dependency from the parser to the desugarer. More details in `Note [The Decoupling Abstract Data Hack]`. In the future, we hope to undo this hack again in favour of breaking the dependency from the parser to DynFlags altogether. - - - - - 2 changed files: - compiler/GHC/Driver/Hooks.hs - compiler/GHC/HsToCore/Types.hs Changes: ===================================== compiler/GHC/Driver/Hooks.hs ===================================== @@ -3,7 +3,7 @@ -- NB: this module is SOURCE-imported by DynFlags, and should primarily -- refer to *types*, rather than *code* -{-# LANGUAGE CPP, RankNTypes #-} +{-# LANGUAGE CPP, RankNTypes, TypeFamilies #-} module GHC.Driver.Hooks ( Hooks @@ -11,6 +11,7 @@ module GHC.Driver.Hooks , lookupHook , getHooked -- the hooks: + , DsForeignsHook , dsForeignsHook , tcForeignImportsHook , tcForeignExportsHook @@ -36,9 +37,7 @@ import GHC.Driver.Types import GHC.Hs.Decls import GHC.Hs.Binds import GHC.Hs.Expr -import GHC.Data.OrdList import GHC.Tc.Types -import GHC.HsToCore.Types import GHC.Data.Bag import GHC.Types.Name.Reader import GHC.Types.Name @@ -59,6 +58,7 @@ import GHC.Hs.Extension import GHC.StgToCmm.Types (ModuleLFInfos) import Data.Maybe +import qualified Data.Kind {- ************************************************************************ @@ -90,9 +90,32 @@ emptyHooks = Hooks , cmmToRawCmmHook = Nothing } +{- Note [The Decoupling Abstract Data Hack] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The "Abstract Data" idea is due to Richard Eisenberg in +https://gitlab.haskell.org/ghc/ghc/-/merge_requests/1957, where the pattern is +described in more detail. + +Here we use it as a temporary measure to break the dependency from the Parser on +the Desugarer until the parser is free of DynFlags. We introduced a nullary type +family @DsForeignsook@, whose single definition is in GHC.HsToCore.Types, where +we instantiate it to + + [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)) + +In doing so, the Hooks module (which is an hs-boot dependency of DynFlags) can +be decoupled from its use of the DsM definition in GHC.HsToCore.Types. Since +both DsM and the definition of @ForeignsHook@ live in the same module, there is +virtually no difference for plugin authors that want to write a foreign hook. +-} + +-- See Note [The Decoupling Abstract Data Hack] +type family DsForeignsHook :: Data.Kind.Type + data Hooks = Hooks - { dsForeignsHook :: Maybe ([LForeignDecl GhcTc] - -> DsM (ForeignStubs, OrdList (Id, CoreExpr))) + { dsForeignsHook :: Maybe DsForeignsHook + -- ^ Actual type: + -- @Maybe ([LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)))@ , tcForeignImportsHook :: Maybe ([LForeignDecl GhcRn] -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt)) , tcForeignExportsHook :: Maybe ([LForeignDecl GhcRn] ===================================== compiler/GHC/HsToCore/Types.hs ===================================== @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeFamilies, UndecidableInstances #-} + -- | Various types used during desugaring. module GHC.HsToCore.Types ( DsM, DsLclEnv(..), DsGblEnv(..), @@ -10,13 +12,17 @@ import GHC.Types.CostCentre.State import GHC.Types.Name.Env import GHC.Types.SrcLoc import GHC.Types.Var -import GHC.Hs (HsExpr, GhcTc) +import GHC.Hs (LForeignDecl, HsExpr, GhcTc) import GHC.Tc.Types (TcRnIf, IfGblEnv, IfLclEnv, CompleteMatches) import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) +import GHC.Core (CoreExpr) import GHC.Core.FamInstEnv import GHC.Utils.Error import GHC.Utils.Outputable as Outputable import GHC.Unit.Module +import GHC.Driver.Hooks (DsForeignsHook) +import GHC.Data.OrdList (OrdList) +import GHC.Driver.Types (ForeignStubs) {- ************************************************************************ @@ -75,3 +81,5 @@ data DsMetaVal -- | Desugaring monad. See also 'TcM'. type DsM = TcRnIf DsGblEnv DsLclEnv +-- See Note [The Decoupling Abstract Data Hack] +type instance DsForeignsHook = [LForeignDecl GhcTc] -> DsM (ForeignStubs, OrdList (Id, CoreExpr)) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9280042ca55ccd66d3e419e41e62a2bd2e28bd6f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9280042ca55ccd66d3e419e41e62a2bd2e28bd6f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 14:35:47 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 10 Sep 2020 10:35:47 -0400 Subject: [Git][ghc/ghc][master] 2 commits: Add long-distance info for pattern bindings (#18572) Message-ID: <5f5a39c31201_80bd8c2564114223e4@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 19 changed files: - compiler/GHC/Data/OrdList.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Utils/Misc.hs - testsuite/tests/deSugar/should_compile/ds020.stderr - testsuite/tests/module/all.T - + testsuite/tests/pmcheck/should_compile/T18572.hs - + testsuite/tests/pmcheck/should_compile/T18572.stderr - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/rename/should_compile/T7085.stderr - testsuite/tests/unboxedsums/all.T Changes: ===================================== compiler/GHC/Data/OrdList.hs ===================================== @@ -5,13 +5,16 @@ -} {-# LANGUAGE DeriveFunctor #-} - {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} -- | Provide trees (of instructions), so that lists of instructions can be -- appended in linear time. module GHC.Data.OrdList ( - OrdList, + OrdList, pattern NilOL, pattern ConsOL, pattern SnocOL, nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL, headOL, mapOL, fromOL, toOL, foldrOL, foldlOL, reverseOL, fromOLReverse, @@ -79,6 +82,50 @@ snocOL as b = Snoc as b consOL a bs = Cons a bs concatOL aas = foldr appOL None aas +pattern NilOL :: OrdList a +pattern NilOL <- (isNilOL -> True) where + NilOL = None + +-- | An unboxed 'Maybe' type with two unboxed fields in the 'Just' case. +-- Useful for defining 'viewCons' and 'viewSnoc' without overhead. +type VMaybe a b = (# (# a, b #) | (# #) #) +pattern VJust :: a -> b -> VMaybe a b +pattern VJust a b = (# (# a, b #) | #) +pattern VNothing :: VMaybe a b +pattern VNothing = (# | (# #) #) +{-# COMPLETE VJust, VNothing #-} + +pattern ConsOL :: a -> OrdList a -> OrdList a +pattern ConsOL x xs <- (viewCons -> VJust x xs) where + ConsOL x xs = consOL x xs +{-# COMPLETE NilOL, ConsOL #-} +viewCons :: OrdList a -> VMaybe a (OrdList a) +viewCons (One a) = VJust a NilOL +viewCons (Cons a as) = VJust a as +viewCons (Snoc as a) = case viewCons as of + VJust a' as' -> VJust a' (Snoc as' a) + VNothing -> VJust a NilOL +viewCons (Two as1 as2) = case viewCons as1 of + VJust a' as1' -> VJust a' (Two as1' as2) + VNothing -> viewCons as2 +viewCons _ = VNothing + +pattern SnocOL :: OrdList a -> a -> OrdList a +pattern SnocOL xs x <- (viewSnoc -> VJust xs x) where + SnocOL xs x = snocOL xs x +{-# COMPLETE NilOL, SnocOL #-} +viewSnoc :: OrdList a -> VMaybe (OrdList a) a +viewSnoc (One a) = VJust NilOL a +viewSnoc (Many (reverse -> a:as)) = VJust (Many (reverse as)) a +viewSnoc (Snoc as a) = VJust as a +viewSnoc (Cons a as) = case viewSnoc as of + VJust as' a' -> VJust (Cons a as') a' + VNothing -> VJust NilOL a +viewSnoc (Two as1 as2) = case viewSnoc as2 of + VJust as2' a' -> VJust (Two as1 as2') a' + VNothing -> viewSnoc as1 +viewSnoc _ = VNothing + headOL None = panic "headOL" headOL (One a) = a headOL (Many as) = head as @@ -189,5 +236,3 @@ strictlyOrdOL (Two a1 a2) (Two b1 b2) = strictlyOrdOL (Two _ _) _ = LT strictlyOrdOL (Many as) (Many bs) = compare as bs strictlyOrdOL (Many _ ) _ = GT - - ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -33,7 +33,7 @@ import {-# SOURCE #-} GHC.HsToCore.Match ( matchWrapper ) import GHC.HsToCore.Monad import GHC.HsToCore.GuardedRHSs import GHC.HsToCore.Utils -import GHC.HsToCore.PmCheck ( addTyCsDs, checkGRHSs ) +import GHC.HsToCore.PmCheck ( addTyCs, covCheckGRHSs ) import GHC.Hs -- lots of things import GHC.Core -- lots of things @@ -152,14 +152,14 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun , fun_matches = matches , fun_ext = co_fn , fun_tick = tick }) - = do { (args, body) <- addTyCsDs FromSource (hsWrapDictBinders co_fn) $ + = do { (args, body) <- addTyCs FromSource (hsWrapDictBinders co_fn) $ -- FromSource might not be accurate (we don't have any -- origin annotations for things in this module), but at -- worst we do superfluous calls to the pattern match -- oracle. - -- addTyCsDs: Add type evidence to the refinement type + -- addTyCs: Add type evidence to the refinement type -- predicate of the coverage checker - -- See Note [Type and Term Equality Propagation] in "GHC.HsToCore.PmCheck" + -- See Note [Long-distance information] in "GHC.HsToCore.PmCheck" matchWrapper (mkPrefixFunRhs (L loc (idName fun))) Nothing matches @@ -185,7 +185,7 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = ty , pat_ticks = (rhs_tick, var_ticks) }) - = do { rhss_deltas <- checkGRHSs PatBindGuards grhss + = do { rhss_deltas <- covCheckGRHSs PatBindGuards grhss ; body_expr <- dsGuarded grhss ty rhss_deltas ; let body' = mkOptTickBox rhs_tick body_expr pat' = decideBangHood dflags pat @@ -201,11 +201,11 @@ dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts , abs_exports = exports , abs_ev_binds = ev_binds , abs_binds = binds, abs_sig = has_sig }) - = do { ds_binds <- addTyCsDs FromSource (listToBag dicts) $ + = do { ds_binds <- addTyCs FromSource (listToBag dicts) $ dsLHsBinds binds - -- addTyCsDs: push type constraints deeper + -- addTyCs: push type constraints deeper -- for inner pattern match check - -- See Check, Note [Type and Term Equality Propagation] + -- See Check, Note [Long-distance information] ; ds_ev_binds <- dsTcEvBinds_s ev_binds ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -31,7 +31,7 @@ import GHC.HsToCore.ListComp import GHC.HsToCore.Utils import GHC.HsToCore.Arrows import GHC.HsToCore.Monad -import GHC.HsToCore.PmCheck ( addTyCsDs, checkGRHSs ) +import GHC.HsToCore.PmCheck ( addTyCs, covCheckGRHSs ) import GHC.Types.Name import GHC.Types.Name.Env import GHC.Core.FamInstEnv( topNormaliseType ) @@ -215,7 +215,7 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss , pat_ext = ty }) body = -- let C x# y# = rhs in body -- ==> case rhs of C x# y# -> body - do { match_deltas <- checkGRHSs PatBindGuards grhss + do { match_deltas <- covCheckGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_deltas ; let upat = unLoc pat eqn = EqnInfo { eqn_pats = [upat], @@ -283,7 +283,7 @@ dsExpr hswrap@(XExpr (WrapExpr (HsWrap co_fn e))) HsConLikeOut _ (RealDataCon dc) -> return $ varToCoreExpr (dataConWrapId dc) XExpr (WrapExpr (HsWrap _ _)) -> pprPanic "dsExpr: HsWrap inside HsWrap" (ppr hswrap) HsPar _ _ -> pprPanic "dsExpr: HsPar inside HsWrap" (ppr hswrap) - _ -> addTyCsDs FromSource (hsWrapDictBinders co_fn) $ + _ -> addTyCs FromSource (hsWrapDictBinders co_fn) $ dsExpr e -- See Note [Detecting forced eta expansion] ; wrap' <- dsHsWrapper co_fn @@ -486,7 +486,7 @@ dsExpr (HsMultiIf res_ty alts) | otherwise = do { let grhss = GRHSs noExtField alts (noLoc emptyLocalBinds) - ; rhss_deltas <- checkGRHSs IfAlt grhss + ; rhss_deltas <- covCheckGRHSs IfAlt grhss ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_deltas ; error_expr <- mkErrorExpr ; extractMatchResult match_result error_expr } @@ -981,7 +981,7 @@ dsDo ctx stmts = do { body <- goL stmts ; rhs' <- dsLExpr rhs ; var <- selectSimpleMatchVarL (xbstc_boundResultMult xbs) pat - ; match <- matchSinglePatVar var (StmtCtxt ctx) pat + ; match <- matchSinglePatVar var Nothing (StmtCtxt ctx) pat (xbstc_boundResultType xbs) (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure ctx pat match (xbstc_failOp xbs) ; dsSyntaxExpr (xbstc_bindOp xbs) [rhs', Lam var match_code] } @@ -1002,7 +1002,7 @@ dsDo ctx stmts ; let match_args (pat, fail_op) (vs,body) = do { var <- selectSimpleMatchVarL Many pat - ; match <- matchSinglePatVar var (StmtCtxt ctx) pat + ; match <- matchSinglePatVar var Nothing (StmtCtxt ctx) pat body_ty (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure ctx pat match fail_op ; return (var:vs, match_code) ===================================== compiler/GHC/HsToCore/GuardedRHSs.hs ===================================== @@ -36,7 +36,7 @@ import Control.Monad ( zipWithM ) import Data.List.NonEmpty ( NonEmpty, toList ) {- - at dsGuarded@ is used for pattern bindings. + at dsGuarded@ is used for GRHSs. It desugars: \begin{verbatim} | g1 -> e1 @@ -44,7 +44,7 @@ It desugars: | gn -> en where binds \end{verbatim} -producing an expression with a runtime error in the corner if +producing an expression with a runtime error in the corner case if necessary. The type argument gives the type of the @ei at . -} @@ -137,8 +137,8 @@ matchGuards (BindStmt _ pat bind_rhs : stmts) ctx deltas rhs rhs_ty = do match_result <- matchGuards stmts ctx deltas rhs rhs_ty core_rhs <- dsLExpr bind_rhs - match_result' <- matchSinglePatVar match_var (StmtCtxt ctx) pat rhs_ty - match_result + match_result' <- matchSinglePatVar match_var (Just core_rhs) (StmtCtxt ctx) + pat rhs_ty match_result pure $ bindNonRec match_var core_rhs <$> match_result' matchGuards (LastStmt {} : _) _ _ _ _ = panic "matchGuards LastStmt" ===================================== compiler/GHC/HsToCore/ListComp.hs ===================================== @@ -617,7 +617,7 @@ dsMcBindStmt :: LPat GhcTc dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts = do { body <- dsMcStmts stmts ; var <- selectSimpleMatchVarL Many pat - ; match <- matchSinglePatVar var (StmtCtxt (DoExpr Nothing)) pat + ; match <- matchSinglePatVar var Nothing (StmtCtxt (DoExpr Nothing)) pat res1_ty (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure (MonadComp :: HsStmtContext GhcRn) pat match fail_op ; dsSyntaxExpr bind_op [rhs', Lam var match_code] } ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -66,7 +66,7 @@ import GHC.Data.FastString import GHC.Types.Unique import GHC.Types.Unique.DFM -import Control.Monad(zipWithM, unless ) +import Control.Monad ( zipWithM, unless, when ) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NEL import qualified Data.Map as Map @@ -769,9 +769,9 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches -- @rhss_deltas@ is a flat list of covered Deltas for each RHS. -- Each Match will split off one Deltas for its RHSs from this. ; matches_deltas <- if isMatchContextPmChecked dflags origin ctxt - then addScrutTmCs mb_scr new_vars $ - -- See Note [Type and Term Equality Propagation] - checkMatches (DsMatchContext ctxt locn) new_vars matches + then addHsScrutTmCs mb_scr new_vars $ + -- See Note [Long-distance information] + covCheckMatches (DsMatchContext ctxt locn) new_vars matches else pure (initDeltasMatches matches) ; eqns_info <- zipWithM mk_eqn_info matches matches_deltas @@ -820,25 +820,24 @@ matchEquations ctxt vars eqns_info rhs_ty ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc ; extractMatchResult match_result fail_expr } -{- -************************************************************************ -* * -\subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern} -* * -************************************************************************ - - at mkSimpleMatch@ is a wrapper for @match@ which deals with the -situation where we want to match a single expression against a single -pattern. It returns an expression. --} - +-- | @matchSimply@ is a wrapper for 'match' which deals with the +-- situation where we want to match a single expression against a single +-- pattern. It returns an expression. matchSimply :: CoreExpr -- ^ Scrutinee -> HsMatchContext GhcRn -- ^ Match kind -> LPat GhcTc -- ^ Pattern it should match -> CoreExpr -- ^ Return this if it matches -> CoreExpr -- ^ Return this if it doesn't -> DsM CoreExpr --- Do not warn about incomplete patterns; see matchSinglePat comments +-- Some reasons 'matchSimply' is not defined using 'matchWrapper' (#18572): +-- * Some call sites like in 'deBindComp' specify a @fail_expr@ that isn't a +-- straight @patError@ +-- * It receives an already desugared 'CoreExpr' for the scrutinee, not an +-- 'HsExpr' like 'matchWrapper' expects +-- * Filling in all the phony fields for the 'MatchGroup' for a single pattern +-- match is awkward +-- * And we still export 'matchSinglePatVar', so not much is gained if we +-- don't also implement it in terms of 'matchWrapper' matchSimply scrut hs_ctx pat result_expr fail_expr = do let match_result = cantFailMatchResult result_expr @@ -858,7 +857,7 @@ matchSinglePat :: CoreExpr -> HsMatchContext GhcRn -> LPat GhcTc matchSinglePat (Var var) ctx pat ty match_result | not (isExternalName (idName var)) - = matchSinglePatVar var ctx pat ty match_result + = matchSinglePatVar var Nothing ctx pat ty match_result matchSinglePat scrut hs_ctx pat ty match_result = do { var <- selectSimpleMatchVarL Many pat @@ -867,22 +866,22 @@ matchSinglePat scrut hs_ctx pat ty match_result -- and to create field selectors. All of which only -- bind unrestricted variables, hence the 'Many' -- above. - ; match_result' <- matchSinglePatVar var hs_ctx pat ty match_result + ; match_result' <- matchSinglePatVar var (Just scrut) hs_ctx pat ty match_result ; return $ bindNonRec var scrut <$> match_result' } matchSinglePatVar :: Id -- See Note [Match Ids] + -> Maybe CoreExpr -- ^ The scrutinee the match id is bound to -> HsMatchContext GhcRn -> LPat GhcTc -> Type -> MatchResult CoreExpr -> DsM (MatchResult CoreExpr) -matchSinglePatVar var ctx pat ty match_result +matchSinglePatVar var mb_scrut ctx pat ty match_result = ASSERT2( isInternalName (idName var), ppr var ) do { dflags <- getDynFlags ; locn <- getSrcSpanDs - -- Pattern match check warnings - ; if isMatchContextPmChecked dflags FromSource ctx - then checkSingle dflags (DsMatchContext ctx locn) var (unLoc pat) - else pure () + ; when (isMatchContextPmChecked dflags FromSource ctx) $ + addCoreScrutTmCs mb_scrut [var] $ + covCheckPatBind (DsMatchContext ctx locn) var (unLoc pat) ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] , eqn_orig = FromSource ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -29,6 +29,7 @@ matchSimply matchSinglePatVar :: Id + -> Maybe CoreExpr -> HsMatchContext GhcRn -> LPat GhcTc -> Type ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -1,24 +1,51 @@ -{- -Author: George Karachalias - -Pattern Matching Coverage Checking. --} - -{-# LANGUAGE CPP #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} - +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | This module coverage checks pattern matches. It finds +-- +-- * Uncovered patterns, certifying non-exhaustivity +-- * Redundant equations +-- * Equations with an inaccessible right-hand-side +-- +-- The algorithm is based on the paper +-- [Lower Your Guards: A Compositional Pattern-Match Coverage Checker"](https://dl.acm.org/doi/abs/10.1145/3408989) +-- +-- There is an overview Figure 2 in there that's probably helpful. +-- Here is an overview of how it's implemented, which follows the structure of +-- the entry points such as 'covCheckMatches': +-- +-- 1. Desugar source syntax (like 'LMatch') to guard tree variants (like +-- 'GrdMatch'), with one of the desugaring functions (like 'desugarMatch'). +-- Follows Section 3.1 in the paper. +-- 2. Coverage check guard trees (with a function like 'checkMatch') to get a +-- 'CheckResult', containing +-- a. The set of uncovered values, 'cr_uncov' +-- b. And an annotated tree variant (like 'AnnMatch') that captures +-- redundancy and inaccessibility information as 'RedSets' annotations +-- Basically the UA function from Section 5.1. The Normalised Refinement Types +-- Nabla are modeled as 'Deltas' and checked in "GHC.HsToCore.PmCheck.Oracle". +-- 3. Collect redundancy information into a 'CIRB' with a function such +-- as 'cirbsMatch'. Follows the R function from Figure 6 of the paper. +-- 4. Format and report uncovered patterns and redundant equations ('CIRB') +-- with 'formatReportWarnings'. Basically job of the G function, plus proper +-- pretty printing of the warnings (Section 5.4 of the paper). +-- 5. Return 'Deltas' reaching syntactic sub-components for +-- Note [Long-distance information]. Collected by functions such as +-- 'ldiMatch'. See Section 4.1 of the paper. module GHC.HsToCore.PmCheck ( -- Checking and printing - checkSingle, checkMatches, checkGRHSs, + covCheckPatBind, covCheckMatches, covCheckGRHSs, isMatchContextPmChecked, - -- See Note [Type and Term Equality Propagation] - addTyCsDs, addScrutTmCs + -- See Note [Long-distance information] + addTyCs, addCoreScrutTmCs, addHsScrutTmCs ) where #include "HsVersions.h" @@ -37,7 +64,6 @@ import GHC.Tc.Utils.Zonk (shortCutLit) import GHC.Types.Id import GHC.Core.ConLike import GHC.Types.Name -import GHC.Tc.Instance.Family import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Misc @@ -62,35 +88,148 @@ import GHC.Core.Type import GHC.HsToCore.Utils (isTrueLHsExpr) import GHC.Data.Maybe import qualified GHC.LanguageExtensions as LangExt -import GHC.Utils.Monad (concatMapM) +import GHC.Utils.Monad (concatMapM, mapMaybeM) import Control.Monad (when, forM_, zipWithM) import Data.List (elemIndex) import qualified Data.Semigroup as Semi -import Data.List.NonEmpty (NonEmpty(..)) +import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE +import Data.Coerce -{- -This module checks pattern matches for: -\begin{enumerate} - \item Equations that are redundant - \item Equations with inaccessible right-hand-side - \item Exhaustiveness -\end{enumerate} +-- +-- * Exported entry points to the checker +-- -The algorithm is based on the paper: +-- | A non-empty delta that is initialised from the ambient refinement type +-- capturing long-distance information, or the trivially habitable 'Deltas' if +-- the former is uninhabited. +-- See Note [Recovering from unsatisfiable pattern-matching constraints]. +getLdiDeltas :: DsM Deltas +getLdiDeltas = do + deltas <- getPmDeltas + isInhabited deltas >>= \case + True -> pure deltas + False -> pure initDeltas + +-- | Check a pattern binding (let, where) for exhaustiveness. +covCheckPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () +-- See Note [covCheckPatBind only checks PatBindRhs] +covCheckPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do + missing <- getLdiDeltas + pat_bind <- desugarPatBind loc var p + tracePm "covCheckPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) + result <- unCA (checkPatBind pat_bind) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsPatBind ctxt [var] result +covCheckPatBind _ _ _ = pure () + +-- | Exhaustive for guard matches, is used for guards in pattern bindings and +-- in @MultiIf@ expressions. Returns the 'Deltas' covered by the RHSs. +covCheckGRHSs + :: HsMatchContext GhcRn -- ^ Match context, for warning messages + -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check + -> DsM (NonEmpty Deltas) -- ^ Covered 'Deltas' for each RHS, for long + -- distance info +covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do + let combined_loc = foldl1 combineSrcSpans (map getLoc grhss) + ctxt = DsMatchContext hs_ctxt combined_loc + matches <- desugarGRHSs combined_loc empty guards + missing <- getLdiDeltas + tracePm "covCheckGRHSs" (hang (vcat [ppr ctxt + , text "Guards:"]) + 2 + (pprGRHSs hs_ctxt guards $$ ppr missing)) + result <- unCA (checkGRHSs matches) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsGRHSs ctxt [] result + return (ldiGRHS <$> cr_ret result) + +-- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each +-- with a 'Pat' and one or more 'GRHSs': +-- +-- @ +-- f x y | x == y = 1 -- match on x and y with two guarded RHSs +-- | otherwise = 2 +-- f _ _ = 3 -- clause with a single, un-guarded RHS +-- @ +-- +-- Returns one non-empty 'Deltas' for 1.) each pattern of a 'Match' and 2.) +-- each of a 'Match'es 'GRHS' for Note [Long-distance information]. +-- +-- Special case: When there are /no matches/, then the functionassumes it +-- checks and @-XEmptyCase@ with only a single match variable. +-- See Note [Checking EmptyCase]. +covCheckMatches + :: DsMatchContext -- ^ Match context, for warnings messages + -> [Id] -- ^ Match variables, i.e. x and y above + -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches + -> DsM [(Deltas, NonEmpty Deltas)] -- ^ One covered 'Deltas' per Match and + -- GRHS, for long distance info. +covCheckMatches ctxt vars matches = do + -- We have to force @missing@ before printing out the trace message, + -- otherwise we get interleaved output from the solver. This function + -- should be strict in @missing@ anyway! + !missing <- getLdiDeltas + tracePm "covCheckMatches {" $ + hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) + 2 + (vcat (map ppr matches) $$ ppr missing) + case NE.nonEmpty matches of + Nothing -> do + -- This must be an -XEmptyCase. See Note [Checking EmptyCase] + let var = only vars + empty_case <- desugarEmptyCase var + result <- unCA (checkEmptyCase empty_case) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsEmptyCase ctxt vars result + return [] + Just matches -> do + matches <- desugarMatches vars matches + result <- unCA (checkMatchGroup matches) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsMatchGroup ctxt vars result + return (NE.toList (ldiMatchGroup (cr_ret result))) + +{- Note [covCheckPatBind only checks PatBindRhs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + at covCheckPatBind@'s sole purpose is to check vanilla pattern bindings, like + at x :: Int; Just x = e@, which is in a @PatBindRhs@ context. +But its caller is also called for individual pattern guards in a @StmtCtxt at . +For example, both pattern guards in @f x y | True <- x, False <- y = ...@ will +go through this function. It makes no sense to do coverage checking there: + * Pattern guards may well fail. Fall-through is not an unrecoverable panic, + but rather behavior the programmer expects, so inexhaustivity should not be + reported. + * Redundancy is already reported for the whole GRHS via one of the other + exported coverage checking functions. Also reporting individual redundant + guards is... redundant. See #17646. +Note that we can't just omit checking of @StmtCtxt@ altogether (by adjusting +'isMatchContextPmChecked'), because that affects the other checking functions, +too. + +Note [Checking EmptyCase] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-XEmptyCase is useful for matching on empty data types like 'Void'. For example, +the following is a complete match: - "GADTs Meet Their Match: - Pattern-matching Warnings That Account for GADTs, Guards, and Laziness" + f :: Void -> () + f x = case x of {} - https://www.microsoft.com/en-us/research/wp-content/uploads/2016/08/gadtpm-acm.pdf +Really, -XEmptyCase is the only way to write a program that at the same time is +safe (@f _ = error "boom"@ is not because of ⊥), doesn't trigger a warning +(@f !_ = error "inaccessible" has inaccessible RHS) and doesn't turn an +exception into divergence (@f x = f x@). -%************************************************************************ -%* * - Pattern Match Check Types -%* * -%************************************************************************ +Semantically, unlike every other case expression, -XEmptyCase is strict in its +match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the +initial Delta and check if there are any values left to match on. -} +-- +-- * Guard language +-- + -- | A very simple language for pattern guards. Let bindings, bang patterns, -- and matching variables against flat constructor patterns. data PmGrd @@ -106,9 +245,9 @@ data PmGrd } -- | @PmBang x@ corresponds to a @seq x True@ guard. - -- If the extra SrcInfo is present, the bang guard came from a source - -- bang pattern, in which case we might want to report it as redundant, - -- see Note [Dead bang patterns]. + -- If the extra 'SrcInfo' is present, the bang guard came from a source + -- bang pattern, in which case we might want to report it as redundant. + -- See Note [Dead bang patterns]. | PmBang { pm_id :: !Id, pm_loc :: !(Maybe SrcInfo) @@ -144,24 +283,115 @@ instance Monoid Precision where mempty = Precise mappend = (Semi.<>) --- | Means by which we identify source location for later pretty-printing --- in a warning message. 'SDoc' for the equation to show, 'Located' for --- the location. +-- +-- * Guard tree language +-- + +-- | Means by which we identify a source construct for later pretty-printing in +-- a warning message. 'SDoc' for the equation to show, 'Located' for the +-- location. type SrcInfo = Located SDoc --- | A representation of the desugaring to 'PmGrd's of all clauses of a --- function definition/pattern match/etc. -data GrdTree - = Rhs !SrcInfo - | Guard !PmGrd !GrdTree - -- ^ @Guard grd t@ will try to match @grd@ and on success continue to match - -- @t at . Falls through if either match fails. Models left-to-right semantics - -- of pattern matching. - | Sequence ![GrdTree] - -- ^ @Sequence (t:ts)@ matches against @t@, and then matches all - -- fallen-through values against @Sequence ts at . Models top-to-bottom semantics - -- of pattern matching. - -- @Sequence []@ always fails; it is useful for Note [Checking EmptyCase]. +-- | Redundancy sets, used to determine redundancy of RHSs and bang patterns +-- (later digested into a 'CIRB'). +data RedSets + = RedSets + { rs_cov :: !Deltas + -- ^ The /Covered/ set; the set of values reaching a particular program + -- point. + , rs_div :: !Deltas + -- ^ The /Diverging/ set; empty if no match can lead to divergence. + -- If it wasn't empty, we have to turn redundancy warnings into + -- inaccessibility warnings for any subclauses. + , rs_bangs :: !(OrdList (Deltas, SrcInfo)) + -- ^ If any of the 'Deltas' is empty, the corresponding 'SrcInfo' pin-points + -- a bang pattern in source that is redundant. See Note [Dead bang patterns]. + } + +-- The following two type synonyms instantiate our tree structures to guard +-- trees and annotated trees, respectively, by giving the types to attach as +-- payload. + +-- | Used as tree payload pre-checking. The LYG guards to check. +type Pre = [PmGrd] + +-- | Used as tree payload post-checking. The redundancy info we elaborated. +type Post = RedSets + +-- | A guard tree denoting 'MatchGroup'. +newtype PmMatchGroup p = PmMatchGroup (NonEmpty (PmMatch p)) + +-- | A guard tree denoting 'Match': A payload describing the pats and a bunch of +-- GRHS. +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(NonEmpty (PmGRHS p)) } + +-- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' +-- useful for printing out in warnings messages. +data PmGRHS p = PmGRHS { pg_grds :: !p, pg_rhs :: !SrcInfo } + +-- | A guard tree denoting an -XEmptyCase. +newtype PmEmptyCase = PmEmptyCase { pe_var :: Id } + +-- | A guard tree denoting a pattern binding. +newtype PmPatBind p = + -- just reuse GrdGRHS and pretend its @SrcInfo@ is info on the /pattern/, + -- rather than on the pattern bindings. + PmPatBind (PmGRHS p) + +emptyRedSets :: RedSets +-- Semigroup instance would be misleading! +emptyRedSets = RedSets mempty mempty mempty + +pprSrcInfo :: SrcInfo -> SDoc +pprSrcInfo (L (RealSrcSpan rss _) _) = ppr (srcSpanStartLine rss) +pprSrcInfo (L s _) = ppr s + +-- | Format LYG guards as @| True <- x, let x = 42, !z@ +pprLygGuards :: [PmGrd] -> SDoc +pprLygGuards [] = empty +pprLygGuards (g:gs) = fsep (char '|' <+> ppr g : map ((comma <+>) . ppr) gs) + +-- | Format a LYG sequence (e.g. 'Match'es of a 'MatchGroup' or 'GRHSs') as +-- @{ ; ...; }@ +pprLygSequence :: Outputable a => NonEmpty a -> SDoc +pprLygSequence (NE.toList -> as) = + braces (space <> fsep (punctuate semi (map ppr as)) <> space) + +instance Outputable (PmMatchGroup Pre) where + ppr (PmMatchGroup matches) = pprLygSequence matches + +instance Outputable (PmMatch Pre) where + ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = + pprLygGuards grds <+> ppr grhss + +instance Outputable (PmGRHS Pre) where + ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = + pprLygGuards grds <+> text "->" <+> pprSrcInfo rhs + +instance Outputable (PmPatBind Pre) where + ppr (PmPatBind PmGRHS { pg_grds = grds, pg_rhs = bind }) = + ppr bind <+> pprLygGuards grds <+> text "=" <+> text "..." + +instance Outputable PmEmptyCase where + ppr (PmEmptyCase { pe_var = var }) = + text " ppr var <> text ">" + +pprRedSets :: RedSets -> SDoc +-- It's useful to change this definition for different verbosity levels in +-- printf-debugging +pprRedSets RedSets { rs_cov = _cov, rs_div = _div, rs_bangs = _bangs } + = empty + +instance Outputable (PmMatchGroup Post) where + ppr (PmMatchGroup matches) = pprLygSequence matches + +instance Outputable (PmMatch Post) where + ppr (PmMatch { pm_pats = red, pm_grhss = grhss }) = + pprRedSets red <+> ppr grhss + +instance Outputable (PmGRHS Post) where + ppr (PmGRHS { pg_grds = red, pg_rhs = rhs }) = + pprRedSets red <+> text "->" <+> pprSrcInfo rhs {- Note [Dead bang patterns] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -178,7 +408,7 @@ that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs; see below. We can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable -where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is +where the PmBang appears in 'checkGrd'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. @@ -197,235 +427,9 @@ it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. -} --- | The digest of 'checkGrdTree', representing the annotated pattern-match --- tree. 'extractRedundancyInfo' can figure out redundant and proper --- inaccessible RHSs from this, as well as dead bangs. -data AnnotatedTree - = AccessibleRhs !Deltas !SrcInfo - -- ^ A RHS deemed accessible. The 'Deltas' is the (non-empty) set of covered - -- values. - | InaccessibleRhs !SrcInfo - -- ^ A RHS deemed inaccessible; it covers no value. - | MayDiverge !AnnotatedTree - -- ^ Asserts that the tree may force diverging values, so not all of its - -- clauses can be redundant. - | SequenceAnn !Deltas ![AnnotatedTree] - -- ^ @SequenceAnn inc ts@ mirrors @'Sequence' ts@ for preserving the - -- skeleton of a 'GrdTree's @ts at . It also carries the set of incoming values - -- @inc at . - | RedundantSrcBang !SrcInfo !AnnotatedTree - -- ^ For tracking redundant bangs. See Note [Dead bang patterns] - -pprSrcInfo :: SrcInfo -> SDoc -pprSrcInfo (L (RealSrcSpan rss _) _) = ppr (srcSpanStartLine rss) -pprSrcInfo (L s _) = ppr s - -instance Outputable GrdTree where - ppr (Rhs info) = text "->" <+> pprSrcInfo info - -- Format guards as "| True <- x, let x = 42, !z" - ppr g at Guard{} = fsep (prefix (map ppr grds)) <+> ppr t - where - (t, grds) = collect_grds g - collect_grds (Guard grd t) = (grd :) <$> collect_grds t - collect_grds t = (t, []) - prefix [] = [] - prefix (s:sdocs) = char '|' <+> s : map (comma <+>) sdocs - ppr (Sequence []) = text "" - ppr (Sequence ts) = braces (space <> fsep (punctuate semi (map ppr ts)) <> space) - -instance Outputable AnnotatedTree where - ppr (AccessibleRhs _delta info) = parens (ppr _delta) <+> pprSrcInfo info - ppr (InaccessibleRhs info) = text "inaccessible" <+> pprSrcInfo info - ppr (MayDiverge t) = text "div" <+> ppr t - ppr (SequenceAnn _ []) = text "" - ppr (SequenceAnn _ ts) = braces (space <> fsep (punctuate semi (map ppr ts)) <> space) - ppr (RedundantSrcBang l t) = text "redundant bang" <+> pprSrcInfo l <+> ppr t - --- | Lift 'addPmCts' over 'Deltas'. -addPmCtsDeltas :: Deltas -> PmCts -> DsM Deltas -addPmCtsDeltas deltas cts = liftDeltasM (\d -> addPmCts d cts) deltas - --- | 'addPmCtsDeltas' a single 'PmCt'. -addPmCtDeltas :: Deltas -> PmCt -> DsM Deltas -addPmCtDeltas deltas ct = addPmCtsDeltas deltas (unitBag ct) - --- | Test if any of the 'Delta's is inhabited. Currently this is pure, because --- we preserve the invariant that there are no uninhabited 'Delta's. But that --- could change in the future, for example by implementing this function in --- terms of @notNull <$> provideEvidence 1 ds at . -isInhabited :: Deltas -> DsM Bool -isInhabited (MkDeltas ds) = pure (not (null ds)) - --- | Pattern-match check result -data CheckResult - = CheckResult - { cr_clauses :: !AnnotatedTree - -- ^ Captures redundancy info for each clause in the original program. - -- (for -Woverlapping-patterns) - , cr_uncov :: !Deltas - -- ^ The set of uncovered values falling out at the bottom. - -- (for -Wincomplete-patterns) - , cr_approx :: !Precision - -- ^ A flag saying whether we ran into the 'maxPmCheckModels' limit for the - -- purpose of suggesting to crank it up in the warning message - } - -instance Outputable CheckResult where - ppr (CheckResult c unc pc) - = text "CheckResult" <+> ppr_precision pc <+> braces (fsep - [ field "clauses" c <> comma - , field "uncov" unc]) - where - ppr_precision Precise = empty - ppr_precision Approximate = text "(Approximate)" - field name value = text name <+> equals <+> ppr value - -{- -%************************************************************************ -%* * - Entry points to the checker: checkSingle and checkMatches -%* * -%************************************************************************ --} - --- | Check a single pattern binding (let) for exhaustiveness. -checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () -checkSingle dflags ctxt@(DsMatchContext kind locn) var p = do - tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - -- We only ever need to run this in a context where we need exhaustivity - -- warnings (so not in pattern guards or comprehensions, for example, because - -- they are perfectly fine to fail). - -- Omitting checking this flag emits redundancy warnings twice in obscure - -- cases like #17646. - when (exhaustive dflags kind) $ do - -- TODO: This could probably call checkMatches, like checkGRHSs. - missing <- getPmDeltas - tracePm "checkSingle: missing" (ppr missing) - fam_insts <- dsGetFamInstEnvs - grd_tree <- mkGrdTreeRhs (L locn $ ppr p) <$> translatePat fam_insts var p - res <- checkGrdTree grd_tree missing - dsPmWarn dflags ctxt [var] res - --- | Exhaustive for guard matches, is used for guards in pattern bindings and --- in @MultiIf@ expressions. Returns the 'Deltas' covered by the RHSs. -checkGRHSs - :: HsMatchContext GhcRn -- ^ Match context, for warning messages - -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check - -> DsM (NonEmpty Deltas) -- ^ Covered 'Deltas' for each RHS, for long - -- distance info -checkGRHSs hs_ctx guards@(GRHSs _ grhss _) = do - let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) - dsMatchContext = DsMatchContext hs_ctx combinedLoc - match = L combinedLoc $ - Match { m_ext = noExtField - , m_ctxt = hs_ctx - , m_pats = [] - , m_grhss = guards } - [(_, deltas)] <- checkMatches dsMatchContext [] [match] - pure deltas - --- | Check a list of syntactic /match/es (part of case, functions, etc.), each --- with a /pat/ and one or more /grhss/: -- --- @ --- f x y | x == y = 1 -- match on x and y with two guarded RHSs --- | otherwise = 2 --- f _ _ = 3 -- clause with a single, un-guarded RHS --- @ +-- * Desugaring source syntax to guard trees -- --- Returns one 'Deltas' for each GRHS, representing its covered values, or the --- incoming uncovered 'Deltas' (from 'getPmDeltas') if the GRHS is inaccessible. --- Since there is at least one /grhs/ per /match/, the list of 'Deltas' is at --- least as long as the list of matches. -checkMatches - :: DsMatchContext -- ^ Match context, for warnings messages - -> [Id] -- ^ Match variables, i.e. x and y above - -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches - -> DsM [(Deltas, NonEmpty Deltas)] -- ^ One covered 'Deltas' per RHS, for long - -- distance info. -checkMatches ctxt vars matches = do - tracePm "checkMatches" (hang (vcat [ppr ctxt - , ppr vars - , text "Matches:"]) - 2 - (vcat (map ppr matches))) - - init_deltas <- getPmDeltas - missing <- case matches of - -- This must be an -XEmptyCase. See Note [Checking EmptyCase] - [] | [var] <- vars -> addPmCtDeltas init_deltas (PmNotBotCt var) - _ -> pure init_deltas - fam_insts <- dsGetFamInstEnvs - grd_tree <- translateMatches fam_insts vars matches - res <- checkGrdTree grd_tree missing - - dflags <- getDynFlags - dsPmWarn dflags ctxt vars res - - return (extractRhsDeltas (cr_clauses res)) - --- | Extract the 'Deltas' reaching the RHSs of the 'AnnotatedTree' for a match --- group. --- For 'AccessibleRhs's, this is stored in the tree node, whereas --- 'InaccessibleRhs's fall back to the supplied original 'Deltas'. --- See @Note [Recovering from unsatisfiable pattern-matching constraints]@. -extractRhsDeltas :: AnnotatedTree -> [(Deltas, NonEmpty Deltas)] -extractRhsDeltas = go_matches - where - go_matches :: AnnotatedTree -> [(Deltas, NonEmpty Deltas)] - go_matches (SequenceAnn def ts) = map (go_match def) ts -- -XEmptyCase handled here! - go_matches t = pprPanic "extractRhsDeltas.go_matches" (text "Matches must start with SequenceAnn. But was" $$ ppr t) - - go_match :: Deltas -> AnnotatedTree -> (Deltas, NonEmpty Deltas) - -- There is no -XEmptyCase at this level, only at the Matches level. So @ts@ - -- is non-empty! - go_match def (SequenceAnn pat ts) = (pat, foldMap1 (text "go_match: empty SequenceAnn") (go_grhss def) ts) - go_match def (MayDiverge t) = go_match def t - go_match def (RedundantSrcBang _ t) = go_match def t - -- Even if there's only a single GRHS, we wrap it in a SequenceAnn for the - -- Deltas covered by the pattern. So the remaining cases are impossible! - go_match _ t = pprPanic "extractRhsDeltas.go_match" (text "Single GRHS must be wrapped in SequenceAnn. But got " $$ ppr t) - - go_grhss :: Deltas -> AnnotatedTree -> NonEmpty Deltas - -- There is no -XEmptyCase at this level, only at the Matches level. So @ts@ - -- is non-empty! - go_grhss def (SequenceAnn _ ts) = foldMap1 (text "go_grhss: empty SequenceAnn") (go_grhss def) ts - go_grhss def (MayDiverge t) = go_grhss def t - go_grhss def (RedundantSrcBang _ t) = go_grhss def t - go_grhss _ (AccessibleRhs deltas _) = deltas :| [] - go_grhss def (InaccessibleRhs _) = def :| [] - - foldMap1 msg _ [] = pprPanic "extractRhsDeltas.foldMap1" msg - foldMap1 _ f (x:xs) = foldl' (\acc x -> acc Semi.<> f x) (f x) xs - -{- Note [Checking EmptyCase] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --XEmptyCase is useful for matching on empty data types like 'Void'. For example, -the following is a complete match: - - f :: Void -> () - f x = case x of {} - -Really, -XEmptyCase is the only way to write a program that at the same time is -safe (@f _ = error "boom"@ is not because of ⊥), doesn't trigger a warning -(@f !_ = error "inaccessible" has inaccessible RHS) and doesn't turn an -exception into divergence (@f x = f x@). - -Semantically, unlike every other case expression, -XEmptyCase is strict in its -match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the -initial Delta and check if there are any values left to match on. --} - -{- -%************************************************************************ -%* * - Transform source syntax to *our* syntax -%* * -%************************************************************************ --} - --- ----------------------------------------------------------------------- --- * Utilities -- | Smart constructor that eliminates trivial lets mkPmLetVar :: Id -> Id -> GrdVec @@ -458,7 +462,7 @@ mkListGrds a ((x, head_grds):xs) = do -- | Create a 'GrdVec' refining a match variable to a 'PmLit'. mkPmLitGrds :: Id -> PmLit -> DsM GrdVec mkPmLitGrds x (PmLit _ (PmLitString s)) = do - -- We translate String literals to list literals for better overlap reasoning. + -- We desugar String literals to list literals for better overlap reasoning. -- It's a little unfortunate we do this here rather than in -- 'GHC.HsToCore.PmCheck.Oracle.trySolve' and -- 'GHC.HsToCore.PmCheck.Oracle.addRefutableAltCon', but it's so much simpler @@ -476,37 +480,34 @@ mkPmLitGrds x lit = do , pm_con_args = [] } pure [grd] --- ----------------------------------------------------------------------- --- * Transform (Pat Id) into GrdVec - --- | @translatePat _ x pat@ transforms @pat@ into a 'GrdVec', where +-- | @desugarPat _ x pat@ transforms @pat@ into a 'GrdVec', where -- the variable representing the match is @x at . -translatePat :: FamInstEnvs -> Id -> Pat GhcTc -> DsM GrdVec -translatePat fam_insts x pat = case pat of +desugarPat :: Id -> Pat GhcTc -> DsM GrdVec +desugarPat x pat = case pat of WildPat _ty -> pure [] VarPat _ y -> pure (mkPmLetVar (unLoc y) x) - ParPat _ p -> translateLPat fam_insts x p + ParPat _ p -> desugarLPat x p LazyPat _ _ -> pure [] -- like a wildcard BangPat _ p@(L l p') -> -- Add the bang in front of the list, because it will happen before any -- nested stuff. - (PmBang x pm_loc :) <$> translateLPat fam_insts x p - where pm_loc = Just (L l (ppr p')) + (PmBang x pm_loc :) <$> desugarLPat x p + where pm_loc = Just (L l (ppr p')) - -- (x at pat) ==> Translate pat with x as match var and handle impedance + -- (x at pat) ==> Desugar pat with x as match var and handle impedance -- mismatch with incoming match var - AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> translateLPat fam_insts y p + AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> desugarLPat y p - SigPat _ p _ty -> translateLPat fam_insts x p + SigPat _ p _ty -> desugarLPat x p - -- See Note [Translate CoPats] + -- See Note [Desugar CoPats] -- Generally the translation is -- pat |> co ===> let y = x |> co, pat <- y where y is a match var of pat XPat (CoPat wrapper p _ty) - | isIdHsWrapper wrapper -> translatePat fam_insts x p - | WpCast co <- wrapper, isReflexiveCo co -> translatePat fam_insts x p + | isIdHsWrapper wrapper -> desugarPat x p + | WpCast co <- wrapper, isReflexiveCo co -> desugarPat x p | otherwise -> do - (y, grds) <- translatePatV fam_insts p + (y, grds) <- desugarPatV p wrap_rhs_y <- dsHsWrapper wrapper pure (PmLet y (wrap_rhs_y (Var x)) : grds) @@ -521,13 +522,13 @@ translatePat fam_insts x pat = case pat of -- (fun -> pat) ===> let y = fun x, pat <- y where y is a match var of pat ViewPat _arg_ty lexpr pat -> do - (y, grds) <- translateLPatV fam_insts pat + (y, grds) <- desugarLPatV pat fun <- dsLExpr lexpr pure $ PmLet y (App fun (Var x)) : grds -- list ListPat (ListPatTc _elem_ty Nothing) ps -> - translateListPat fam_insts x ps + desugarListPat x ps -- overloaded list ListPat (ListPatTc elem_ty (Just (pat_ty, to_list))) pats -> do @@ -535,11 +536,11 @@ translatePat fam_insts x pat = case pat of case splitListTyConApp_maybe pat_ty of Just _e_ty | not (xopt LangExt.RebindableSyntax dflags) - -- Just translate it as a regular ListPat - -> translateListPat fam_insts x pats + -- Just desugar it as a regular ListPat + -> desugarListPat x pats _ -> do y <- mkPmId (mkListTy elem_ty) - grds <- translateListPat fam_insts y pats + grds <- desugarListPat y pats rhs_y <- dsSyntaxExpr to_list [Var x] pure $ PmLet y rhs_y : grds @@ -565,7 +566,7 @@ translatePat fam_insts x pat = case pat of , cpt_dicts = dicts } } -> do - translateConPatOut fam_insts x con arg_tys ex_tvs dicts ps + desugarConPatOut x con arg_tys ex_tvs dicts ps NPat ty (L _ olit) mb_neg _ -> do -- See Note [Literal short cut] in "GHC.HsToCore.Match.Literal" @@ -594,46 +595,44 @@ translatePat fam_insts x pat = case pat of mkPmLitGrds x lit TuplePat _tys pats boxity -> do - (vars, grdss) <- mapAndUnzipM (translateLPatV fam_insts) pats + (vars, grdss) <- mapAndUnzipM desugarLPatV pats let tuple_con = tupleDataCon boxity (length vars) pure $ vanillaConGrd x tuple_con vars : concat grdss SumPat _ty p alt arity -> do - (y, grds) <- translateLPatV fam_insts p + (y, grds) <- desugarLPatV p let sum_con = sumDataCon alt arity -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon pure $ vanillaConGrd x sum_con [y] : grds - -- -------------------------------------------------------------------------- - -- Not supposed to happen - SplicePat {} -> panic "Check.translatePat: SplicePat" + SplicePat {} -> panic "Check.desugarPat: SplicePat" --- | 'translatePat', but also select and return a new match var. -translatePatV :: FamInstEnvs -> Pat GhcTc -> DsM (Id, GrdVec) -translatePatV fam_insts pat = do +-- | 'desugarPat', but also select and return a new match var. +desugarPatV :: Pat GhcTc -> DsM (Id, GrdVec) +desugarPatV pat = do x <- selectMatchVar Many pat - grds <- translatePat fam_insts x pat + grds <- desugarPat x pat pure (x, grds) -translateLPat :: FamInstEnvs -> Id -> LPat GhcTc -> DsM GrdVec -translateLPat fam_insts x = translatePat fam_insts x . unLoc +desugarLPat :: Id -> LPat GhcTc -> DsM GrdVec +desugarLPat x = desugarPat x . unLoc --- | 'translateLPat', but also select and return a new match var. -translateLPatV :: FamInstEnvs -> LPat GhcTc -> DsM (Id, GrdVec) -translateLPatV fam_insts = translatePatV fam_insts . unLoc +-- | 'desugarLPat', but also select and return a new match var. +desugarLPatV :: LPat GhcTc -> DsM (Id, GrdVec) +desugarLPatV = desugarPatV . unLoc --- | @translateListPat _ x [p1, ..., pn]@ is basically --- @translateConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever +-- | @desugarListPat _ x [p1, ..., pn]@ is basically +-- @desugarConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever -- constructing the 'ConPatOut's. -translateListPat :: FamInstEnvs -> Id -> [LPat GhcTc] -> DsM GrdVec -translateListPat fam_insts x pats = do - vars_and_grdss <- traverse (translateLPatV fam_insts) pats +desugarListPat :: Id -> [LPat GhcTc] -> DsM GrdVec +desugarListPat x pats = do + vars_and_grdss <- traverse desugarLPatV pats mkListGrds x vars_and_grdss --- | Translate a constructor pattern -translateConPatOut :: FamInstEnvs -> Id -> ConLike -> [Type] -> [TyVar] +-- | Desugar a constructor pattern +desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar] -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdVec -translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case +desugarConPatOut x con univ_tys ex_tvs dicts = \case PrefixCon ps -> go_field_pats (zip [0..] ps) InfixCon p1 p2 -> go_field_pats (zip [0..] [p1,p2]) RecCon (HsRecFields fs _) -> go_field_pats (rec_field_ps fs) @@ -647,7 +646,7 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case where tagged_pat f = (lbl_to_index (getName (hsRecFieldId f)), hsRecFieldArg f) -- Unfortunately the label info is empty when the DataCon wasn't defined - -- with record field labels, hence we translate to field index. + -- with record field labels, hence we desugar to field index. orig_lbls = map flSelector $ conLikeFieldLabels con lbl_to_index lbl = expectJust "lbl_to_index" $ elemIndex lbl orig_lbls @@ -658,10 +657,10 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case -- the first field of @tagged_pats at . -- See Note [Field match order for RecCon] - -- Translate the mentioned field patterns. We're doing this first to get + -- Desugar the mentioned field patterns. We're doing this first to get -- the Ids for pm_con_args. let trans_pat (n, pat) = do - (var, pvec) <- translateLPatV fam_insts pat + (var, pvec) <- desugarLPatV pat pure ((n, var), pvec) (tagged_vars, arg_grdss) <- mapAndUnzipM trans_pat tagged_pats @@ -687,77 +686,81 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case -- 1. 2. 3. pure (con_grd : bang_grds ++ arg_grds) --- | Translate a the 'Match'es of a 'MatchGroup' -translateMatches :: FamInstEnvs -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] - -> DsM GrdTree -translateMatches fam_insts vars matches = - -- It's important that we wrap a 'Sequence' even if it only wraps a singleton. - -- 'extractRhsDeltas' needs this to recover 'MatchGroup' structure. - Sequence <$> traverse (translateMatch fam_insts vars) matches - --- Translate a single match -translateMatch :: FamInstEnvs -> [Id] -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM GrdTree -translateMatch fam_insts vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do - pats' <- concat <$> zipWithM (translateLPat fam_insts) vars pats - grhss' <- translateGRHSs fam_insts match_loc (sep (map ppr pats)) grhss - -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr grhss']) - return (foldr Guard grhss' pats') - -mkGrdTreeRhs :: Located SDoc -> GrdVec -> GrdTree -mkGrdTreeRhs sdoc = foldr Guard (Rhs sdoc) - -translateGRHSs :: FamInstEnvs -> SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM GrdTree -translateGRHSs fam_insts match_loc pp_pats grhss = - -- It's important that we wrap a 'Sequence' even if it only wraps a singleton. - -- 'extractRhsDeltas' needs this to recover 'GRHSs' structure. - Sequence <$> traverse (translateLGRHS fam_insts match_loc pp_pats) (grhssGRHSs grhss) - --- | Translate a guarded right-hand side to a single 'GrdTree' -translateLGRHS :: FamInstEnvs -> SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM GrdTree -translateLGRHS fam_insts match_loc pp_pats (L _loc (GRHS _ gs _)) = - -- _loc points to the match separator (ie =, ->) that comes after the guards.. - mkGrdTreeRhs loc_sdoc <$> concatMapM (translateGuard fam_insts . unLoc) gs - where - loc_sdoc - -- pp_pats is the space-separated pattern of the current Match this - -- GRHS belongs to, so the @A B x@ part in @A B x | 0 <- x at . - | null gs = L match_loc pp_pats - | otherwise = L grd_loc (pp_pats <+> vbar <+> interpp'SP gs) - L grd_loc _ = head gs - --- | Translate a guard statement to a 'GrdVec' -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM GrdVec -translateGuard fam_insts guard = case guard of - BodyStmt _ e _ _ -> translateBoolGuard e - LetStmt _ binds -> translateLet (unLoc binds) - BindStmt _ p e -> translateBind fam_insts p e - LastStmt {} -> panic "translateGuard LastStmt" - ParStmt {} -> panic "translateGuard ParStmt" - TransStmt {} -> panic "translateGuard TransStmt" - RecStmt {} -> panic "translateGuard RecStmt" - ApplicativeStmt {} -> panic "translateGuard ApplicativeLastStmt" - --- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM GrdVec -translateLet _binds = return [] - --- | Translate a pattern guard +desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre) +-- See 'GrdPatBind' for how this simply repurposes GrdGRHS. +desugarPatBind loc var pat = + PmPatBind . flip PmGRHS (L loc (ppr pat)) <$> desugarPat var pat + +desugarEmptyCase :: Id -> DsM PmEmptyCase +desugarEmptyCase var = pure PmEmptyCase { pe_var = var } + +-- | Desugar the non-empty 'Match'es of a 'MatchGroup'. +desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc)) + -> DsM (PmMatchGroup Pre) +desugarMatches vars matches = + PmMatchGroup <$> traverse (desugarMatch vars) matches + +-- Desugar a single match +desugarMatch :: [Id] -> LMatch GhcTc (LHsExpr GhcTc) -> DsM (PmMatch Pre) +desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do + pats' <- concat <$> zipWithM desugarLPat vars pats + grhss' <- desugarGRHSs match_loc (sep (map ppr pats)) grhss + -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss']) + return PmMatch { pm_pats = pats', pm_grhss = grhss' } + +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (NonEmpty (PmGRHS Pre)) +desugarGRHSs match_loc pp_pats grhss + = traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + +-- | Desugar a guarded right-hand side to a single 'GrdTree' +desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) +desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do + -- _loc points to the match separator (ie =, ->) that comes after the guards. + -- Hence we have to pass in the match_loc, which we use in case that the RHS + -- is unguarded. + -- pp_pats is the space-separated pattern of the current Match this + -- GRHS belongs to, so the @A B x@ part in @A B x | 0 <- x at . + let rhs_info = case gs of + [] -> L match_loc pp_pats + (L grd_loc _):_ -> L grd_loc (pp_pats <+> vbar <+> interpp'SP gs) + grds <- concatMapM (desugarGuard . unLoc) gs + pure PmGRHS { pg_grds = grds, pg_rhs = rhs_info } + +-- | Desugar a guard statement to a 'GrdVec' +desugarGuard :: GuardStmt GhcTc -> DsM GrdVec +desugarGuard guard = case guard of + BodyStmt _ e _ _ -> desugarBoolGuard e + LetStmt _ binds -> desugarLet (unLoc binds) + BindStmt _ p e -> desugarBind p e + LastStmt {} -> panic "desugarGuard LastStmt" + ParStmt {} -> panic "desugarGuard ParStmt" + TransStmt {} -> panic "desugarGuard TransStmt" + RecStmt {} -> panic "desugarGuard RecStmt" + ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" + +-- | Desugar let-bindings +desugarLet :: HsLocalBinds GhcTc -> DsM GrdVec +desugarLet _binds = return [] + +-- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM GrdVec -translateBind fam_insts p e = dsLExpr e >>= \case +desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM GrdVec +desugarBind p e = dsLExpr e >>= \case Var y | Nothing <- isDataConId_maybe y -- RHS is a variable, so that will allow us to omit the let - -> translateLPat fam_insts y p + -> desugarLPat y p rhs -> do - (x, grds) <- translateLPatV fam_insts p + (x, grds) <- desugarLPatV p pure (PmLet x rhs : grds) --- | Translate a boolean guard +-- | Desugar a boolean guard -- @e ==> let x = e; True <- x@ -translateBoolGuard :: LHsExpr GhcTc -> DsM GrdVec -translateBoolGuard e +desugarBoolGuard :: LHsExpr GhcTc -> DsM GrdVec +desugarBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) -- but it is trivial to solve so instead we give back an empty @@ -802,7 +805,7 @@ for a pattern match appear matter. Consider a situation similar to T5117: f (0:_) = () f (0:[]) = () -The latter clause is clearly redundant. Yet if we translate the second clause as +The latter clause is clearly redundant. Yet if we desugar the second clause as [x:xs' <- xs, [] <- xs', 0 <- x] @@ -814,52 +817,11 @@ translation would have been And we have to take in the guards on list cells into @mkListGrds at . -Note [Countering exponential blowup] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Precise pattern match exhaustiveness checking is necessarily exponential in -the size of some input programs. We implement a counter-measure in the form of -the -fmax-pmcheck-models flag, limiting the number of Deltas we check against -each pattern by a constant. - -How do we do that? Consider - - f True True = () - f True True = () - -And imagine we set our limit to 1 for the sake of the example. The first clause -will be checked against the initial Delta, {}. Doing so will produce an -Uncovered set of size 2, containing the models {x/~True} and {x~True,y/~True}. -Also we find the first clause to cover the model {x~True,y~True}. - -But the Uncovered set we get out of the match is too huge! We somehow have to -ensure not to make things worse as they are already, so we continue checking -with a singleton Uncovered set of the initial Delta {}. Why is this -sound (wrt. notion of the GADTs Meet their Match paper)? Well, it basically -amounts to forgetting that we matched against the first clause. The values -represented by {} are a superset of those represented by its two refinements -{x/~True} and {x~True,y/~True}. - -This forgetfulness becomes very apparent in the example above: By continuing -with {} we don't detect the second clause as redundant, as it again covers the -same non-empty subset of {}. So we don't flag everything as redundant anymore, -but still will never flag something as redundant that isn't. - -For exhaustivity, the converse applies: We will report @f@ as non-exhaustive -and report @f _ _@ as missing, which is a superset of the actual missing -matches. But soundness means we will never fail to report a missing match. - -This mechanism is implemented in 'throttle'. - -Guards are an extreme example in this regard, with #11195 being a particularly -dreadful example: Since their RHS are often pretty much unique, we split on a -variable (the one representing the RHS) that doesn't occur anywhere else in the -program, so we don't actually get useful information out of that split! - -Note [Translate CoPats] +Note [Desugar CoPats] ~~~~~~~~~~~~~~~~~~~~~~~ -The pattern match checker did not know how to handle coerced patterns `CoPat` -efficiently, which gave rise to #11276. The original approach translated -`CoPat`s: +The pattern match checker did not know how to handle coerced patterns +`CoPat` efficiently, which gave rise to #11276. The original approach +desugared `CoPat`s: pat |> co ===> x (pat <- (x |> co)) @@ -874,108 +836,92 @@ a lot of false warnings. But we can check whether the coercion is a hole or if it is just refl, in which case we can drop it. - -%************************************************************************ -%* * - Utilities for Pattern Match Checking -%* * -%************************************************************************ -} --- ---------------------------------------------------------------------------- --- * Basic utilities - -{- -Note [Extensions to GADTs Meet Their Match] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The GADTs Meet Their Match paper presents the formalism that GHC's coverage -checker adheres to. Since the paper's publication, there have been some -additional features added to the coverage checker which are not described in -the paper. This Note serves as a reference for these new features. - -* Value abstractions are severely simplified to the point where they are just - variables. The information about the shape of a variable is encoded in - the oracle state 'Delta' instead. -* Handling of uninhabited fields like `!Void`. - See Note [Strict argument type constraints] in GHC.HsToCore.PmCheck.Oracle. -* Efficient handling of literal splitting, large enumerations and accurate - redundancy warnings for `COMPLETE` groups through the oracle. - -Note [Filtering out non-matching COMPLETE sets] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Currently, conlikes in a COMPLETE set are simply grouped by the -type constructor heading the return type. This is nice and simple, but it does -mean that there are scenarios when a COMPLETE set might be incompatible with -the type of a scrutinee. For instance, consider (from #14135): - - data Foo a = Foo1 a | Foo2 a - - pattern MyFoo2 :: Int -> Foo Int - pattern MyFoo2 i = Foo2 i - - {-# COMPLETE Foo1, MyFoo2 #-} - - f :: Foo a -> a - f (Foo1 x) = x - -`f` has an incomplete pattern-match, so when choosing which constructors to -report as unmatched in a warning, GHC must choose between the original set of -data constructors {Foo1, Foo2} and the COMPLETE set {Foo1, MyFoo2}. But observe -that GHC shouldn't even consider the COMPLETE set as a possibility: the return -type of MyFoo2, Foo Int, does not match the type of the scrutinee, Foo a, since -there's no substitution `s` such that s(Foo Int) = Foo a. - -To ensure that GHC doesn't pick this COMPLETE set, it checks each pattern -synonym constructor's return type matches the type of the scrutinee, and if one -doesn't, then we remove the whole COMPLETE set from consideration. - -One might wonder why GHC only checks /pattern synonym/ constructors, and not -/data/ constructors as well. The reason is because that the type of a -GADT constructor very well may not match the type of a scrutinee, and that's -OK. Consider this example (from #14059): - - data SBool (z :: Bool) where - SFalse :: SBool False - STrue :: SBool True - - pattern STooGoodToBeTrue :: forall (z :: Bool). () - => z ~ True - => SBool z - pattern STooGoodToBeTrue = STrue - {-# COMPLETE SFalse, STooGoodToBeTrue #-} - - wobble :: SBool z -> Bool - wobble STooGoodToBeTrue = True - -In the incomplete pattern match for `wobble`, we /do/ want to warn that SFalse -should be matched against, even though its type, SBool False, does not match -the scrutinee type, SBool z. - -SG: Another angle at this is that the implied constraints when we instantiate -universal type variables in the return type of a GADT will lead to *provided* -thetas, whereas when we instantiate the return type of a pattern synonym that -corresponds to a *required* theta. See Note [Pattern synonym result type] in -PatSyn. Note how isValidCompleteMatches will successfully filter out - - pattern Just42 :: Maybe Int - pattern Just42 = Just 42 - -But fail to filter out the equivalent - - pattern Just'42 :: (a ~ Int) => Maybe a - pattern Just'42 = Just 42 - -Which seems fine as far as tcMatchTy is concerned, but it raises a few eye -brows. --} +-- +-- * Coverage checking guard trees into annotated trees +-- -{- -%************************************************************************ -%* * - Heart of the algorithm: checkGrdTree -%* * -%************************************************************************ --} +-- | Pattern-match coverage check result +data CheckResult a + = CheckResult + { cr_ret :: !a + -- ^ A hole for redundancy info and covered sets. + , cr_uncov :: !Deltas + -- ^ The set of uncovered values falling out at the bottom. + -- (for -Wincomplete-patterns, but also important state for the algorithm) + , cr_approx :: !Precision + -- ^ A flag saying whether we ran into the 'maxPmCheckModels' limit for the + -- purpose of suggesting to crank it up in the warning message. Writer state. + } deriving Functor + +instance Outputable a => Outputable (CheckResult a) where + ppr (CheckResult c unc pc) + = text "CheckResult" <+> ppr_precision pc <+> braces (fsep + [ field "ret" c <> comma + , field "uncov" unc]) + where + ppr_precision Precise = empty + ppr_precision Approximate = text "(Approximate)" + field name value = text name <+> equals <+> ppr value + +-- | Lift 'addPmCts' over 'Deltas'. +addPmCtsDeltas :: Deltas -> PmCts -> DsM Deltas +addPmCtsDeltas deltas cts = liftDeltasM (\d -> addPmCts d cts) deltas + +-- | 'addPmCtsDeltas' for a single 'PmCt'. +addPmCtDeltas :: Deltas -> PmCt -> DsM Deltas +addPmCtDeltas deltas ct = addPmCtsDeltas deltas (unitBag ct) + +-- | Test if any of the 'Delta's is inhabited. Currently this is pure, because +-- we preserve the invariant that there are no uninhabited 'Delta's. But that +-- could change in the future, for example by implementing this function in +-- terms of @notNull <$> provideEvidence 1 ds at . +isInhabited :: Deltas -> DsM Bool +isInhabited (MkDeltas ds) = pure (not (null ds)) + +-- | Coverage checking action. Can be composed 'leftToRight' or 'topToBottom'. +newtype CheckAction a = CA { unCA :: Deltas -> DsM (CheckResult a) } + deriving Functor + +-- | Composes 'CheckAction's top-to-bottom: +-- If a value falls through the resulting action, then it must fall through the +-- first action and then through the second action. +-- If a value matches the resulting action, then it either matches the +-- first action or matches the second action. +-- Basically the semantics of the LYG branching construct. +topToBottom :: (top -> bot -> ret) + -> CheckAction top + -> CheckAction bot + -> CheckAction ret +topToBottom f (CA top) (CA bot) = CA $ \inc -> do + t <- top inc + b <- bot (cr_uncov t) + pure CheckResult { cr_ret = f (cr_ret t) (cr_ret b) + , cr_uncov = cr_uncov b + , cr_approx = cr_approx t Semi.<> cr_approx b } + + +-- | Composes 'CheckAction's left-to-right: +-- If a value falls through the resulting action, then it either falls through the +-- first action or through the second action. +-- If a value matches the resulting action, then it must match the first action +-- and then match the second action. +-- Basically the semantics of the LYG guard construct. +leftToRight :: (RedSets -> right -> ret) + -> CheckAction RedSets + -> CheckAction right + -> CheckAction ret +leftToRight f (CA left) (CA right) = CA $ \inc -> do + l <- left inc + r <- right (rs_cov (cr_ret l)) + limit <- maxPmCheckModels <$> getDynFlags + let uncov = cr_uncov l Semi.<> cr_uncov r + -- See Note [Countering exponential blowup] + let (prec', uncov') = throttle limit inc uncov + pure CheckResult { cr_ret = f (cr_ret l) (cr_ret r) + , cr_uncov = uncov' + , cr_approx = prec' Semi.<> cr_approx l Semi.<> cr_approx r } -- | @throttle limit old new@ returns @old@ if the number of 'Delta's in @new@ -- is exceeding the given @limit@ and the @old@ number of 'Delta's. @@ -993,230 +939,226 @@ conMatchForces (PmAltConLike (RealDataCon dc)) | isNewTyCon (dataConTyCon dc) = False conMatchForces _ = True --- | Makes sure that we only wrap a single 'MayDiverge' around an --- 'AnnotatedTree', purely for esthetic reasons. -mayDiverge :: AnnotatedTree -> AnnotatedTree -mayDiverge a@(MayDiverge _) = a -mayDiverge a = MayDiverge a - --- | Computes two things: --- --- * The set of uncovered values not matched by any of the clauses of the --- 'GrdTree'. Note that 'PmCon' guards are the only way in which values --- fall through from one 'Many' branch to the next. --- * An 'AnnotatedTree' that contains divergence and inaccessibility info --- for all clauses. Will be fed to 'extractRedundancyInfo' for --- presenting redundant and proper innaccessible RHSs, as well as dead --- bangs to the user. -checkGrdTree' :: GrdTree -> Deltas -> DsM CheckResult --- RHS: Check that it covers something and wrap Inaccessible if not -checkGrdTree' (Rhs sdoc) deltas = do - is_covered <- isInhabited deltas - let clauses - | is_covered = AccessibleRhs deltas sdoc - | otherwise = InaccessibleRhs sdoc - pure CheckResult - { cr_clauses = clauses - , cr_uncov = MkDeltas emptyBag - , cr_approx = Precise } --- let x = e: Refine with x ~ e -checkGrdTree' (Guard (PmLet x e) tree) deltas = do - deltas' <- addPmCtDeltas deltas (PmCoreCt x e) - checkGrdTree' tree deltas' --- Bang x: Diverge on x ~ ⊥, refine with x /~ ⊥ -checkGrdTree' (Guard (PmBang x src_bang_info) tree) deltas = do - has_diverged <- addPmCtDeltas deltas (PmBotCt x) >>= isInhabited - deltas' <- addPmCtDeltas deltas (PmNotBotCt x) - res <- checkGrdTree' tree deltas' - let clauses - | not has_diverged - , Just info <- src_bang_info - = RedundantSrcBang info (cr_clauses res) - | has_diverged - = mayDiverge (cr_clauses res) - | otherwise -- won't diverge and it wasn't a source bang - = cr_clauses res - - pure res{ cr_clauses = clauses } - --- Con: Diverge on x ~ ⊥, fall through on x /~ K and refine with x ~ K ys --- and type info -checkGrdTree' (Guard (PmCon x con tvs dicts args) tree) deltas = do - has_diverged <- - if conMatchForces con - then addPmCtDeltas deltas (PmBotCt x) >>= isInhabited - else pure False - unc_this <- addPmCtDeltas deltas (PmNotConCt x con) - deltas' <- addPmCtsDeltas deltas $ - listToBag (PmTyCt . evVarPred <$> dicts) `snocBag` PmConCt x con tvs args - -- tracePm "checkGrdTree:Con" (ppr deltas $$ ppr x $$ ppr con $$ ppr dicts $$ ppr deltas') - CheckResult tree' unc_inner prec <- checkGrdTree' tree deltas' - limit <- maxPmCheckModels <$> getDynFlags - let (prec', unc') = throttle limit deltas (unc_this Semi.<> unc_inner) - pure CheckResult - { cr_clauses = applyWhen has_diverged mayDiverge tree' - , cr_uncov = unc' - , cr_approx = prec Semi.<> prec' } --- Sequence: Thread residual uncovered sets from equation to equation -checkGrdTree' (Sequence ts) init_unc = go [] init_unc Precise ts +-- First the functions that correspond to checking LYG primitives: + +checkSequence :: (grdtree -> CheckAction anntree) -> NonEmpty grdtree -> CheckAction (NonEmpty anntree) +-- The implementation is pretty similar to +-- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ +checkSequence act (t :| []) = (:| []) <$> act t +checkSequence act (t1 :| (t2:ts)) = + topToBottom (NE.<|) (act t1) (checkSequence act (t2:|ts)) + +checkGrd :: PmGrd -> CheckAction RedSets +checkGrd grd = CA $ \inc -> case grd of + -- let x = e: Refine with x ~ e + PmLet x e -> do + matched <- addPmCtDeltas inc (PmCoreCt x e) + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } + , cr_uncov = mempty + , cr_approx = Precise } + -- Bang x _: Diverge on x ~ ⊥, refine with x /~ ⊥ + PmBang x mb_info -> do + div <- addPmCtDeltas inc (PmBotCt x) + matched <- addPmCtDeltas inc (PmNotBotCt x) + -- See Note [Dead bang patterns] + -- mb_info = Just info <==> PmBang originates from bang pattern in source + let bangs | Just info <- mb_info = unitOL (div, info) + | otherwise = NilOL + pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } + , cr_uncov = mempty + , cr_approx = Precise } + -- Con: Diverge on x ~ ⊥, fall through on x /~ K and refine with x ~ K ys + -- and type info + PmCon x con tvs dicts args -> do + div <- if conMatchForces con + then addPmCtDeltas inc (PmBotCt x) + else pure mempty + uncov <- addPmCtDeltas inc (PmNotConCt x con) + matched <- addPmCtsDeltas inc $ + listToBag (PmTyCt . evVarPred <$> dicts) `snocBag` PmConCt x con tvs args + -- tracePm "checkGrd:Con" (ppr inc $$ ppr x $$ ppr con $$ ppr dicts $$ ppr matched) + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } + , cr_uncov = uncov + , cr_approx = Precise } + +checkGrds :: [PmGrd] -> CheckAction RedSets +checkGrds [] = CA $ \inc -> + pure CheckResult { cr_ret = emptyRedSets { rs_cov = inc } + , cr_uncov = mempty + , cr_approx = Precise } +checkGrds (g:grds) = leftToRight merge (checkGrd g) (checkGrds grds) where - -- | Accumulates a CheckResult. Its type is more like - -- @CheckResult -> [GrdTree] -> CheckResult@, but cr_clauses is a single - -- 'AnnotatedTree', not a list thereof. Hence 3 parameters to thread the - -- fields. - go :: [AnnotatedTree] -> Deltas -> Precision -> [GrdTree] -> DsM CheckResult - -- No cases left: Fall through for all values - go ts' unc prec [] = pure CheckResult - { cr_clauses = SequenceAnn init_unc (reverse ts') - , cr_uncov = unc - , cr_approx = prec } - go ts' unc prec (t:ts) = do - CheckResult t' unc_1 prec_t <- checkGrdTree' t unc - go (t':ts') unc_1 (prec_t Semi.<> prec) ts - --- | Print diagnostic info and actually call 'checkGrdTree''. -checkGrdTree :: GrdTree -> Deltas -> DsM CheckResult -checkGrdTree guards deltas = do - tracePm "checkGrdTree {" $ vcat [ ppr guards - , ppr deltas ] - res <- checkGrdTree' guards deltas - tracePm "checkGrdTree }:" (ppr res) -- braces are easier to match by tooling - return res - --- ---------------------------------------------------------------------------- --- * Propagation of term constraints inwards when checking nested matches - -{- Note [Type and Term Equality Propagation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When checking a match it would be great to have all type and term information -available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmVarCsDs' in GHC.HsToCore.Monad that store in the -environment type and term constraints (respectively) as we go deeper. - -The type constraints we propagate inwards are collected by `collectEvVarsPats' -in GHC.Hs.Pat. This handles bug #4139 ( see example - https://gitlab.haskell.org/ghc/ghc/snippets/672 ) -where this is needed. - -For term equalities we do less, we just generate equalities for HsCase. For -example we accurately give 2 redundancy warnings for the marked cases: - -f :: [a] -> Bool -f x = case x of - - [] -> case x of -- brings (x ~ []) in scope - [] -> True - (_:_) -> False -- can't happen - - (_:_) -> case x of -- brings (x ~ (_:_)) in scope - (_:_) -> True - [] -> False -- can't happen - -Functions `addScrutTmCs' is responsible for generating -these constraints. --} + merge ri_g ri_grds = -- This operation would /not/ form a Semigroup! + RedSets { rs_cov = rs_cov ri_grds + , rs_div = rs_div ri_g Semi.<> rs_div ri_grds + , rs_bangs = rs_bangs ri_g Semi.<> rs_bangs ri_grds } --- | Locally update 'dsl_deltas' with the given action, but defer evaluation --- with 'unsafeInterleaveM' in order not to do unnecessary work. -locallyExtendPmDelta :: (Deltas -> DsM Deltas) -> DsM a -> DsM a -locallyExtendPmDelta ext k = do - deltas <- getPmDeltas - deltas' <- unsafeInterleaveM $ do - deltas' <- ext deltas - inh <- isInhabited deltas' - -- If adding a constraint would lead to a contradiction, don't add it. - -- See @Note [Recovering from unsatisfiable pattern-matching constraints]@ - -- for why this is done. - if inh - then pure deltas' - else pure deltas - updPmDeltas deltas' k +checkMatchGroup :: PmMatchGroup Pre -> CheckAction (PmMatchGroup Post) +checkMatchGroup (PmMatchGroup matches) = + PmMatchGroup <$> checkSequence checkMatch matches --- | Add in-scope type constraints if the coverage checker might run and then --- run the given action. -addTyCsDs :: Origin -> Bag EvVar -> DsM a -> DsM a -addTyCsDs origin ev_vars m = do - dflags <- getDynFlags - applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmDelta (\deltas -> addPmCtsDeltas deltas (PmTyCt . evVarPred <$> ev_vars))) - m +checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) +checkMatch (PmMatch { pm_pats = grds, pm_grhss = grhss }) = + leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) --- | Add equalities for the scrutinee to the local 'DsM' environment when --- checking a case expression: --- case e of x { matches } --- When checking matches we record that (x ~ e) where x is the initial --- uncovered. All matches will have to satisfy this equality. -addScrutTmCs :: Maybe (LHsExpr GhcTc) -> [Id] -> DsM a -> DsM a -addScrutTmCs Nothing _ k = k -addScrutTmCs (Just scr) [x] k = do - scr_e <- dsLExpr scr - locallyExtendPmDelta (\deltas -> addPmCtsDeltas deltas (unitBag (PmCoreCt x scr_e))) k -addScrutTmCs _ _ _ = panic "addScrutTmCs: HsCase with more than one case binder" - -{- -%************************************************************************ -%* * - Pretty printing of exhaustiveness/redundancy check warnings -%* * -%************************************************************************ +checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) +checkGRHSs = checkSequence checkGRHS + +checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) +checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = + flip PmGRHS rhs_info <$> checkGrds grds + +checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase +checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do + unc <- addPmCtDeltas inc (PmNotBotCt var) + pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } + +checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) +checkPatBind = coerce checkGRHS + +{- Note [Countering exponential blowup] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Precise pattern match exhaustiveness checking is necessarily exponential in +the size of some input programs. We implement a counter-measure in the form of +the -fmax-pmcheck-models flag, limiting the number of Deltas we check against +each pattern by a constant. + +How do we do that? Consider + + f True True = () + f True True = () + +And imagine we set our limit to 1 for the sake of the example. The first clause +will be checked against the initial Delta, {}. Doing so will produce an +Uncovered set of size 2, containing the models {x/~True} and {x~True,y/~True}. +Also we find the first clause to cover the model {x~True,y~True}. + +But the Uncovered set we get out of the match is too huge! We somehow have to +ensure not to make things worse as they are already, so we continue checking +with a singleton Uncovered set of the initial Delta {}. Why is this +sound (wrt. the notion in GADTs Meet Their Match)? Well, it basically amounts +to forgetting that we matched against the first clause. The values represented +by {} are a superset of those represented by its two refinements {x/~True} and +{x~True,y/~True}. + +This forgetfulness becomes very apparent in the example above: By continuing +with {} we don't detect the second clause as redundant, as it again covers the +same non-empty subset of {}. So we don't flag everything as redundant anymore, +but still will never flag something as redundant that isn't. + +For exhaustivity, the converse applies: We will report @f@ as non-exhaustive +and report @f _ _@ as missing, which is a superset of the actual missing +matches. But soundness means we will never fail to report a missing match. + +This mechanism is implemented in 'throttle'. + +Guards are an extreme example in this regard, with #11195 being a particularly +dreadful example: Since their RHS are often pretty much unique, we split on a +variable (the one representing the RHS) that doesn't occur anywhere else in the +program, so we don't actually get useful information out of that split! -} --- | Check whether any part of pattern match checking is enabled for this --- 'HsMatchContext' (does not matter whether it is the redundancy check or the --- exhaustiveness check). -isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext id -> Bool -isMatchContextPmChecked dflags origin kind - | isGenerated origin - = False - | otherwise - = wopt Opt_WarnOverlappingPatterns dflags || exhaustive dflags kind +-- +-- * Collecting long-distance information +-- --- | Return True when any of the pattern match warnings ('allPmCheckWarnings') --- are enabled, in which case we need to run the pattern match checker. -needToRunPmCheck :: DynFlags -> Origin -> Bool -needToRunPmCheck dflags origin - | isGenerated origin - = False - | otherwise - = notNull (filter (`wopt` dflags) allPmCheckWarnings) +ldiMatchGroup :: PmMatchGroup Post -> NonEmpty (Deltas, NonEmpty Deltas) +ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches + +ldiMatch :: PmMatch Post -> (Deltas, NonEmpty Deltas) +ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = + (rs_cov red, ldiGRHS <$> grhss) + +ldiGRHS :: PmGRHS Post -> Deltas +ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red --- | A type for organising information to be used in warnings. -data RedundancyInfo - = RedundancyInfo - { redundant_rhss :: ![SrcInfo] - , inaccessible_rhss :: ![SrcInfo] - , redundant_bangs :: ![Located SDoc] +-- +-- * Collecting redundancy information +-- + +-- | The result of redundancy checking: +-- * RHSs classified as /C/overed, /I/naccessible and /R/edundant +-- * And redundant /B/ang patterns. See Note [Dead bang patterns]. +data CIRB + = CIRB + { cirb_cov :: !(OrdList SrcInfo) -- ^ Covered clauses + , cirb_inacc :: !(OrdList SrcInfo) -- ^ Inaccessible clauses + , cirb_red :: !(OrdList SrcInfo) -- ^ Redundant clauses + , cirb_bangs :: !(OrdList SrcInfo) -- ^ Redundant bang patterns } -extractRedundancyInfo :: AnnotatedTree -> RedundancyInfo -extractRedundancyInfo tree = - RedundancyInfo { redundant_rhss = fromOL ol_red - , inaccessible_rhss = fromOL ol_inacc - , redundant_bangs = fromOL ol_bangs } - where - (_ol_acc, ol_inacc, ol_red, ol_bangs) = go tree - -- | Collects - -- 1. accessible RHSs - -- 2. proper inaccessible RHSs (so we can't delete them) - -- 3. hypothetically redundant RHSs (so not only inaccessible, but we can - -- even safely delete the equation without altering semantics) - -- 4. 'Dead' bangs from the source, collected to be warned about - -- See Note [Determining inaccessible clauses] - -- See Note [Dead bang patterns] - go :: AnnotatedTree -> (OrdList SrcInfo, OrdList SrcInfo, OrdList SrcInfo, OrdList SrcInfo) - go (AccessibleRhs _ info) = (unitOL info, nilOL, nilOL , nilOL) - go (InaccessibleRhs info) = (nilOL, nilOL, unitOL info, nilOL) -- presumably redundant - go (MayDiverge t) = case go t of - -- See Note [Determining inaccessible clauses] - (acc, inacc, red, bs) - | isNilOL acc && isNilOL inacc -> (nilOL, red, nilOL, bs) - res -> res - go (SequenceAnn _ ts) = foldMap go ts - go (RedundantSrcBang l t) = case go t of - -- See Note [Dead bang patterns] - res@(acc, inacc, _, _) - | isNilOL acc, isNilOL inacc -> res - | otherwise -> (nilOL, nilOL, nilOL, unitOL l) Semi.<> res +instance Semigroup CIRB where + CIRB a b c d <> CIRB e f g h = CIRB (a <> e) (b <> f) (c <> g) (d <> h) + where (<>) = (Semi.<>) + +instance Monoid CIRB where + mempty = CIRB mempty mempty mempty mempty + +markAllRedundant :: CIRB -> CIRB +markAllRedundant CIRB { cirb_cov = cov, cirb_inacc = inacc, cirb_red = red } = + mempty { cirb_red = cov Semi.<> inacc Semi.<> red } + +-- See Note [Determining inaccessible clauses] +ensureOneNotRedundant :: CIRB -> CIRB +ensureOneNotRedundant ci = case ci of + CIRB { cirb_cov = NilOL, cirb_inacc = NilOL, cirb_red = ConsOL r rs } + -> ci { cirb_inacc = unitOL r, cirb_red = rs } + _ -> ci + +-- | Only adds the redundant bangs to the @CIRB@ if there is at least one +-- non-redundant 'SrcInfo'. There is no point in remembering a redundant bang +-- if the whole match is redundant! +addRedundantBangs :: OrdList SrcInfo -> CIRB -> CIRB +addRedundantBangs _red_bangs cirb at CIRB { cirb_cov = NilOL, cirb_inacc = NilOL } = + cirb +addRedundantBangs red_bangs cirb = + cirb { cirb_bangs = cirb_bangs cirb Semi.<> red_bangs } + +-- | Checks the 'Deltas' in a 'RedSets' for inhabitants and returns +-- 1. Whether the Covered set was inhabited +-- 2. Whether the Diverging set was inhabited +-- 3. All source bangs whose 'Deltas' were empty, which means they are +-- redundant. +testRedSets :: RedSets -> DsM (Bool, Bool, OrdList SrcInfo) +testRedSets RedSets { rs_cov = cov, rs_div = div, rs_bangs = bangs } = do + is_covered <- isInhabited cov + may_diverge <- isInhabited div + red_bangs <- flip mapMaybeM (fromOL bangs) $ \(deltas, bang) -> do + isInhabited deltas >>= \case + True -> pure Nothing + False -> pure (Just bang) + pure (is_covered, may_diverge, toOL red_bangs) + +cirbsMatchGroup :: PmMatchGroup Post -> DsM CIRB +cirbsMatchGroup (PmMatchGroup matches) = + Semi.sconcat <$> traverse cirbsMatch matches + +cirbsMatch :: PmMatch Post -> DsM CIRB +cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do + (is_covered, may_diverge, red_bangs) <- testRedSets red + cirb <- cirbsGRHSs grhss + pure $ addRedundantBangs red_bangs + -- See Note [Determining inaccessible clauses] + $ applyWhen may_diverge ensureOneNotRedundant + $ applyWhen (not is_covered) markAllRedundant + $ cirb + +cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB +cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss + +cirbsGRHS :: PmGRHS Post -> DsM CIRB +cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do + (is_covered, may_diverge, red_bangs) <- testRedSets red + let cirb | is_covered = mempty { cirb_cov = unitOL info } + | may_diverge = mempty { cirb_inacc = unitOL info } + | otherwise = mempty { cirb_red = unitOL info } + pure (addRedundantBangs red_bangs cirb) + +cirbsEmptyCase :: PmEmptyCase -> DsM CIRB +cirbsEmptyCase _ = pure mempty + +cirbsPatBind :: PmPatBind Post -> DsM CIRB +cirbsPatBind = coerce cirbsGRHS {- Note [Determining inaccessible clauses] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1231,26 +1173,29 @@ arguments we can ever reach clause 2's RHS, so we say it has inaccessible RHS (as opposed to being completely redundant). We detect an inaccessible RHS simply by pretending it's redundant, until we see -that it's part of a sub-tree in the pattern match that forces some argument -(which corresponds to wrapping the 'AnnotatedTree' in 'MayDiverge'). Then we -turn all supposedly redundant RHSs into inaccessible ones. - -But as it turns out (@g@ from #17465) this is too conservative: - g () | False = () - | otherwise = () -g's first clause has an inaccessible RHS, but it's also safe to delete. So it's -redundant, really! But by just turning all redundant child clauses into -inaccessible ones, we report the first clause as inaccessible. - -Clearly, it is enough if we say that we only degrade if *not all* of the child -clauses are redundant. As long as there is at least one clause which we announce -not to be redundant, the guard prefix responsible for the 'MayDiverge' will -survive. Hence we check for that in 'extractRedundancyInfo'. -} --- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) -dsPmWarn :: DynFlags -> DsMatchContext -> [Id] -> CheckResult -> DsM () -dsPmWarn dflags ctx@(DsMatchContext kind loc) vars result +-- +-- * Formatting and reporting warnings +-- + +-- | Given a function that collects 'CIRB's, this function will emit warnings +-- for a 'CheckResult'. +formatReportWarnings :: (ann -> DsM CIRB) -> DsMatchContext -> [Id] -> CheckResult ann -> DsM () +formatReportWarnings collect ctx vars cr at CheckResult { cr_ret = ann } = do + cov_info <- collect ann + dflags <- getDynFlags + reportWarnings dflags ctx vars cr{cr_ret=cov_info} + +-- | Issue all the warnings +-- (redundancy, inaccessibility, exhaustiveness, redundant bangs). +reportWarnings :: DynFlags -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () +reportWarnings dflags ctx@(DsMatchContext kind loc) vars + CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss + , cirb_red = redundant_rhss + , cirb_bangs = redundant_bangs } + , cr_uncov = uncovered + , cr_approx = precision } = when (flag_i || flag_u || flag_b) $ do unc_examples <- getNFirstUncovered vars (maxPatterns + 1) uncovered let exists_r = flag_i && notNull redundant_rhss @@ -1276,13 +1221,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) vars result when exists_u $ putSrcSpanDs loc $ warnDs flag_u_reason $ pprEqns vars unc_examples where - CheckResult - { cr_clauses = clauses - , cr_uncov = uncovered - , cr_approx = precision } = result - RedundancyInfo{redundant_rhss, inaccessible_rhss, redundant_bangs} - = extractRedundancyInfo clauses - flag_i = overlapping dflags kind flag_u = exhaustive dflags kind flag_b = redundant_bang dflags @@ -1323,44 +1261,30 @@ getNFirstUncovered vars n (MkDeltas deltas) = go n (bagToList deltas) back <- go (n - length front) deltas pure (front ++ back) -{- Note [Inaccessible warnings for record updates] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#12957) - data T a where - T1 :: { x :: Int } -> T Bool - T2 :: { x :: Int } -> T a - T3 :: T a - - f :: T Char -> T a - f r = r { x = 3 } - -The desugarer will (conservatively generate a case for T1 even though -it's impossible: - f r = case r of - T1 x -> T1 3 -- Inaccessible branch - T2 x -> T2 3 - _ -> error "Missing" - -We don't want to warn about the inaccessible branch because the programmer -didn't put it there! So we filter out the warning here. - -The same can happen for long distance term constraints instead of type -constraints (#17783): - - data T = A { x :: Int } | B { x :: Int } - f r at A{} = r { x = 3 } - f _ = B 0 - -Here, the long distance info from the FunRhs match (@r ~ A x@) will make the -clause matching on @B@ of the desugaring to @case@ redundant. It's generated -code that we don't want to warn about. --} - dots :: Int -> [a] -> SDoc dots maxPatterns qs | qs `lengthExceeds` maxPatterns = text "..." | otherwise = empty +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun + = vcat [text txt <+> msg, + sep [ text "In" <+> ppr_match <> char ':' + , nest 4 (rest_of_msg_fun pref)]] + where + txt | singular = "Pattern match" + | otherwise = "Pattern match(es)" + + (ppr_match, pref) + = case kind of + FunRhs { mc_fun = L _ fun } + -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) + _ -> (pprMatchContext kind, \ pp -> pp) + +-- +-- * Utilities +-- + -- | All warning flags that need to run the pattern match checker. allPmCheckWarnings :: [WarningFlag] allPmCheckWarnings = @@ -1399,23 +1323,142 @@ exhaustiveWarningFlag RecUpd = Just Opt_WarnIncompletePatternsRecUpd exhaustiveWarningFlag ThPatSplice = Nothing exhaustiveWarningFlag PatSyn = Nothing exhaustiveWarningFlag ThPatQuote = Nothing -exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete patterns - -- in list comprehensions, pattern guards - -- etc. They are often *supposed* to be - -- incomplete +-- Don't warn about incomplete patterns in list comprehensions, pattern guards +-- etc. They are often *supposed* to be incomplete +exhaustiveWarningFlag (StmtCtxt {}) = Nothing --- True <==> singular -pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun - = vcat [text txt <+> msg, - sep [ text "In" <+> ppr_match <> char ':' - , nest 4 (rest_of_msg_fun pref)]] - where - txt | singular = "Pattern match" - | otherwise = "Pattern match(es)" +-- | Check whether any part of pattern match checking is enabled for this +-- 'HsMatchContext' (does not matter whether it is the redundancy check or the +-- exhaustiveness check). +isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext id -> Bool +isMatchContextPmChecked dflags origin kind + | isGenerated origin + = False + | otherwise + = overlapping dflags kind || exhaustive dflags kind - (ppr_match, pref) - = case kind of - FunRhs { mc_fun = L _ fun } - -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) - _ -> (pprMatchContext kind, \ pp -> pp) +-- | Return True when any of the pattern match warnings ('allPmCheckWarnings') +-- are enabled, in which case we need to run the pattern match checker. +needToRunPmCheck :: DynFlags -> Origin -> Bool +needToRunPmCheck dflags origin + | isGenerated origin + = False + | otherwise + = notNull (filter (`wopt` dflags) allPmCheckWarnings) + +{- Note [Inaccessible warnings for record updates] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#12957) + data T a where + T1 :: { x :: Int } -> T Bool + T2 :: { x :: Int } -> T a + T3 :: T a + + f :: T Char -> T a + f r = r { x = 3 } + +The desugarer will conservatively generate a case for T1 even though +it's impossible: + f r = case r of + T1 x -> T1 3 -- Inaccessible branch + T2 x -> T2 3 + _ -> error "Missing" + +We don't want to warn about the inaccessible branch because the programmer +didn't put it there! So we filter out the warning here. + +The same can happen for long distance term constraints instead of type +constraints (#17783): + + data T = A { x :: Int } | B { x :: Int } + f r at A{} = r { x = 3 } + f _ = B 0 + +Here, the long distance info from the FunRhs match (@r ~ A x@) will make the +clause matching on @B@ of the desugaring to @case@ redundant. It's generated +code that we don't want to warn about. +-} + +-- +-- * Long-distance information +-- + +-- | Locally update 'dsl_deltas' with the given action, but defer evaluation +-- with 'unsafeInterleaveM' in order not to do unnecessary work. +locallyExtendPmDeltas :: (Deltas -> DsM Deltas) -> DsM a -> DsM a +locallyExtendPmDeltas ext k = do + deltas <- getLdiDeltas + deltas' <- unsafeInterleaveM $ ext deltas + updPmDeltas deltas' k + +-- | Add in-scope type constraints if the coverage checker might run and then +-- run the given action. +addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a +addTyCs origin ev_vars m = do + dflags <- getDynFlags + applyWhen (needToRunPmCheck dflags origin) + (locallyExtendPmDeltas (\deltas -> addPmCtsDeltas deltas (PmTyCt . evVarPred <$> ev_vars))) + m + +-- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment +-- when checking a case expression: +-- case e of x { matches } +-- When checking matches we record that (x ~ e) where x is the initial +-- uncovered. All matches will have to satisfy this equality. +addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a +addCoreScrutTmCs Nothing _ k = k +addCoreScrutTmCs (Just scr) [x] k = + flip locallyExtendPmDeltas k $ \deltas -> + addPmCtsDeltas deltas (unitBag (PmCoreCt x scr)) +addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" + +-- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. +addHsScrutTmCs :: Maybe (LHsExpr GhcTc) -> [Id] -> DsM a -> DsM a +addHsScrutTmCs Nothing _ k = k +addHsScrutTmCs (Just scr) vars k = do + scr_e <- dsLExpr scr + addCoreScrutTmCs (Just scr_e) vars k + +{- Note [Long-distance information] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + data Color = R | G | B + f :: Color -> Int + f R = … + f c = … (case c of + G -> True + B -> False) … + +Humans can make the "long-distance connection" between the outer pattern match +and the nested case pattern match to see that the inner pattern match is +exhaustive: @c@ can't be @R@ anymore because it was matched in the first clause +of @f at . + +To achieve similar reasoning in the coverage checker, we keep track of the set +of values that can reach a particular program point (often loosely referred to +as "Covered set") in 'GHC.HsToCore.Monad.dsl_deltas'. +We fill that set with Covered Deltas returned by the exported checking +functions, which the call sites put into place with +'GHC.HsToCore.Monad.updPmDeltas'. +Call sites also extend this set with facts from type-constraint dictionaries, +case scrutinees, etc. with the exported functions 'addTyCs', 'addCoreScrutTmCs' +and 'addHsScrutTmCs'. + +Note [Recovering from unsatisfiable pattern-matching constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the following code (see #12957 and #15450): + + f :: Int ~ Bool => () + f = case True of { False -> () } + +We want to warn that the pattern-matching in `f` is non-exhaustive. But GHC +used not to do this; in fact, it would warn that the match was /redundant/! +This is because the constraint (Int ~ Bool) in `f` is unsatisfiable, and the +coverage checker deems any matches with unsatisfiable constraint sets to be +unreachable. + +We make sure to always start from an inhabited 'Deltas' by calling +'getLdiDeltas', which falls back to the trivially inhabited 'Deltas' if the +long-distance info returned by 'GHC.HsToCore.Monad.getPmDeltas' is empty. +-} ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -167,25 +167,6 @@ mkOneConFull arg_tys con = do -- * Pattern match oracle -{- Note [Recovering from unsatisfiable pattern-matching constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the following code (see #12957 and #15450): - - f :: Int ~ Bool => () - f = case True of { False -> () } - -We want to warn that the pattern-matching in `f` is non-exhaustive. But GHC -used not to do this; in fact, it would warn that the match was /redundant/! -This is because the constraint (Int ~ Bool) in `f` is unsatisfiable, and the -coverage checker deems any matches with unsatisfiable constraint sets to be -unreachable. - -We decide to better than this. When beginning coverage checking, we first -check if the constraints in scope are unsatisfiable, and if so, we start -afresh with an empty set of constraints. This way, we'll get the warnings -that we expect. --} - ------------------------------------- -- * Composable satisfiability checks @@ -1266,7 +1247,7 @@ isTyConTriviallyInhabited tc = elementOfUniqSet tc triviallyInhabitedTyCons {- Note [Checking EmptyCase Expressions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Empty case expressions are strict on the scrutinee. That is, `case x of {}` -will force argument `x`. Hence, `checkMatches` is not sufficient for checking +will force argument `x`. Hence, `covCheckMatches` is not sufficient for checking empty cases, because it assumes that the match is not strict (which is true for all other cases, apart from EmptyCase). This gave rise to #10746. Instead, we do the following: ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -592,5 +592,8 @@ instance Outputable Deltas where instance Semigroup Deltas where MkDeltas l <> MkDeltas r = MkDeltas (l `unionBags` r) +instance Monoid Deltas where + mempty = MkDeltas emptyBag + liftDeltasM :: Monad m => (Delta -> m (Maybe Delta)) -> Deltas -> m Deltas liftDeltasM f (MkDeltas ds) = MkDeltas . catBagMaybes <$> (traverse f ds) ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -323,7 +323,7 @@ data DsLclEnv = DsLclEnv { dsl_meta :: DsMetaEnv, -- Template Haskell bindings dsl_loc :: RealSrcSpan, -- To put in pattern-matching error msgs - -- See Note [Note [Type and Term Equality Propagation] in "GHC.HsToCore.PmCheck" + -- See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck" -- The set of reaching values Deltas is augmented as we walk inwards, -- refined through each pattern match in turn dsl_deltas :: Deltas ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -556,9 +556,8 @@ isSingleton :: [a] -> Bool isSingleton [_] = True isSingleton _ = False -notNull :: [a] -> Bool -notNull [] = False -notNull _ = True +notNull :: Foldable f => f a -> Bool +notNull = not . null only :: [a] -> a #if defined(DEBUG) ===================================== testsuite/tests/deSugar/should_compile/ds020.stderr ===================================== @@ -18,3 +18,11 @@ ds020.hs:20:1: warning: [-Woverlapping-patterns (in -Wdefault)] ds020.hs:23:1: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In an equation for ‘f’: f x@(~[]) = ... + +ds020.hs:32:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: (x1 : xs1 : ys1) = ... + +ds020.hs:33:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: (~x : ~xs : ~ys) = ... ===================================== testsuite/tests/module/all.T ===================================== @@ -83,7 +83,7 @@ test('mod61', normal, compile_fail, ['']) test('mod62', normal, compile_fail, ['']) test('mod63', normal, compile_fail, ['']) test('mod64', normal, compile, ['']) -test('mod65', normal, compile, ['']) +test('mod65', normal, compile, ['-Wno-overlapping-patterns']) test('mod66', normal, compile_fail, ['']) test('mod67', normal, compile_fail, ['']) test('mod68', normal, compile_fail, ['']) ===================================== testsuite/tests/pmcheck/should_compile/T18572.hs ===================================== @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -Wincomplete-uni-patterns -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE DataKinds, KindSignatures, GADTs #-} + +module T18572 where + +True = True -- no warning + +data SBool (b :: Bool) where + STrue :: SBool True + SFalse :: SBool False + +STrue = SFalse -- "redundant", not "inaccessible" ===================================== testsuite/tests/pmcheck/should_compile/T18572.stderr ===================================== @@ -0,0 +1,16 @@ + +T18572.hs:12:1: warning: [-Winaccessible-code (in -Wdefault)] + • Couldn't match type ‘'False’ with ‘'True’ + Inaccessible code in + a pattern with constructor: STrue :: SBool 'True, + in a pattern binding + • In the pattern: STrue + In a pattern binding: STrue = SFalse + +T18572.hs:12:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: STrue = ... + +T18572.hs:12:1: warning: [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: Patterns not matched: SFalse ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -102,6 +102,8 @@ test('T17234', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17248', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17340', normal, compile, + ['-Wredundant-bang-patterns']) test('T17357', expect_broken(17357), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17376', normal, compile, @@ -124,8 +126,8 @@ test('T18478', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18533', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17340', normal, compile, - ['-Wredundant-bang-patterns']) +test('T18572', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, ===================================== testsuite/tests/rename/should_compile/T7085.stderr ===================================== @@ -1,3 +1,7 @@ T7085.hs:8:6: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)] This pattern-binding binds no variables: Nothing = Just n + +T7085.hs:8:6: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: Nothing = ... ===================================== testsuite/tests/unboxedsums/all.T ===================================== @@ -30,5 +30,5 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) # extra_files([ "unboxedsums" + str(i) + ".hs" for i in range(1, 12) ])], # makefile_test, []) -test('UbxSumLevPoly', normal, compile, ['']) +test('UbxSumLevPoly', normal, compile, ['-Wno-overlapping-patterns']) test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4798caa0fefd7adf4c5b85fa84a6f28fcc6b350b...1207576ac0cfdd3fe1ea00b5505f7c874613451e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4798caa0fefd7adf4c5b85fa84a6f28fcc6b350b...1207576ac0cfdd3fe1ea00b5505f7c874613451e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 14:36:16 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 10 Sep 2020 10:36:16 -0400 Subject: [Git][ghc/ghc][master] hadrian: Don't include -fdiagnostics-color in argument hash Message-ID: <5f5a39e05f60f_80b3f84586f56a011424068@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 2 changed files: - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Target.hs Changes: ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -35,6 +35,9 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do hasDynamic = elem dynamic ways mconcat [ arg "-Wall" , not useColor ? builder (Ghc CompileHs) ? + -- N.B. Target.trackArgument ignores this argument from the + -- input hash to avoid superfluous recompilation, avoiding + -- #18672. arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? ===================================== hadrian/src/Target.hs ===================================== @@ -21,11 +21,12 @@ type Target = H.Target Context Builder trackArgument :: Target -> String -> Bool trackArgument target arg = case builder target of Make _ -> not $ threadArg arg - Ghc _ _ -> not $ verbosityArg arg + Ghc _ _ -> not $ verbosityArg arg || diagnosticsColorArg arg Cabal _ _ -> not $ verbosityArg arg || cabal_configure_ignore arg _ -> True where threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="] verbosityArg s = dropWhileEnd isDigit s == "-v" + diagnosticsColorArg s = "-fdiagnostics-color=" `isPrefixOf` s -- N.B. #18672 cabal_configure_ignore s = s `elem` [ "--configure-option=--quiet", "--configure-option=--disable-option-checking" ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95455982df1ef15c6d4585a7d3e93b5e75146a07 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/95455982df1ef15c6d4585a7d3e93b5e75146a07 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 15:03:23 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Thu, 10 Sep 2020 11:03:23 -0400 Subject: [Git][ghc/ghc][wip/T18341] 14 commits: DynFlags: add OptCoercionOpts Message-ID: <5f5a403b4f17c_80bdbc505411429542@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T18341 at Glasgow Haskell Compiler / GHC Commits: 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 6abe4a1c by Sebastian Graf at 2020-09-10T17:02:00+02:00 .gitignore *.hiedb files - - - - - 3777be14 by Sebastian Graf at 2020-09-10T17:03:12+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/SimpleOpt.hs - + compiler/GHC/Core/SimpleOpt.hs-boot - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold.hs-boot - + compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - + compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/592d57ee50ef5bd3a78d1179e79c0f2b4d576a26...3777be14e104f040b826762f5ab42a8b898d85ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/592d57ee50ef5bd3a78d1179e79c0f2b4d576a26...3777be14e104f040b826762f5ab42a8b898d85ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 15:48:21 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 11:48:21 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] base: Make ForeignPtrContents of ForeignPtr strict Message-ID: <5f5a4ac5c013d_80b3f84586f56a01143359e@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: 03b1daef by GHC GitLab CI at 2020-09-10T15:48:13+00:00 base: Make ForeignPtrContents of ForeignPtr strict As mentioned in #17290, there are strong benefits to the `ForeignPtrContents` field of `ForeignPtr` being strict. In particular, when looking at the reproducer for #17746, I noticed that the `ForeignPtrContents` was being allocated on every call to `withForeignPtr` just to be `touch#`'d'. This is a pretty large overhead for something like `withForeignPtr` that should be free. This required updating the `bytestring` submodule to avoid a bottoming `ForeignPtrContents` in `Data.ByteString.Internal` Fixes #17290. - - - - - 2 changed files: - libraries/base/GHC/ForeignPtr.hs - libraries/bytestring Changes: ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -83,7 +83,7 @@ import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) -- type argument of 'ForeignPtr' should normally be an instance of -- class 'Storable'. -- -data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents +data ForeignPtr a = ForeignPtr Addr# !ForeignPtrContents -- The Addr# in the ForeignPtr object is intentionally stored -- separately from the finalizer. The primary aim of the -- representation is to make withForeignPtr efficient; in fact, ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit e6cb01e2ec0bfdd19298418c85f220925a9fa307 +Subproject commit cff1ad3422ed463cf92ea996b276da9156200bbf View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03b1daef7b206c7ad66b8a417381a90b0070d28e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/03b1daef7b206c7ad66b8a417381a90b0070d28e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 15:48:56 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 10 Sep 2020 11:48:56 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/T18638 Message-ID: <5f5a4ae8daa26_80b3f847dce96e011434119@gitlab.haskell.org.mail> Simon Peyton Jones pushed new branch wip/T18638 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T18638 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 15:51:07 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Thu, 10 Sep 2020 11:51:07 -0400 Subject: [Git][ghc/ghc][wip/T18638] 4 commits: Add long-distance info for pattern bindings (#18572) Message-ID: <5f5a4b6ba5139_80b3f849620ae2c114372c0@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18638 at Glasgow Haskell Compiler / GHC Commits: 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 04f0cae6 by Simon Peyton Jones at 2020-09-10T16:50:38+01:00 Do absence analysis on stable unfoldings Ticket #18638 showed that Very Bad Things happen if we fail to do absence analysis on stable unfoldings. It's all described in Note [Absence analysis for stable unfoldings]. I'm a bit surprised this hasn't bitten us before. Fortunately the fix is pretty simple. - - - - - 25 changed files: - compiler/GHC/Core/Opt/DmdAnal.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Utils/Misc.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Target.hs - testsuite/tests/deSugar/should_compile/ds020.stderr - testsuite/tests/module/all.T - + testsuite/tests/pmcheck/should_compile/T18572.hs - + testsuite/tests/pmcheck/should_compile/T18572.stderr - testsuite/tests/pmcheck/should_compile/all.T - testsuite/tests/rename/should_compile/T7085.stderr - + testsuite/tests/simplCore/should_run/T18638.hs - + testsuite/tests/simplCore/should_run/T18638.stdout - testsuite/tests/simplCore/should_run/all.T - testsuite/tests/unboxedsums/all.T Changes: ===================================== compiler/GHC/Core/Opt/DmdAnal.hs ===================================== @@ -552,7 +552,18 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- See Note [Demand signatures are computed for a threshold demand based on idArity] = mkRhsDmd env rhs_arity rhs - (DmdType rhs_fv rhs_dmds rhs_div, rhs') = dmdAnal env rhs_dmd rhs + (rhs_dmd_ty, rhs') = dmdAnal env rhs_dmd rhs + + -- See Note [Absence analysis for stable unfoldings] + unf = realIdUnfolding id + full_dmd_ty | isStableUnfolding unf + , Just unf_body <- maybeUnfoldingTemplate unf + , (unf_dmd_ty, _unf_body') <- dmdAnal env rhs_dmd unf_body + = rhs_dmd_ty `bothDmdType` toBothDmdArg unf_dmd_ty + | otherwise + = rhs_dmd_ty + + DmdType rhs_fv rhs_dmds rhs_div = full_dmd_ty sig = mkStrictSigForArity rhs_arity (DmdType sig_fv rhs_dmds rhs_div) -- See Note [Aggregated demand for cardinality] @@ -799,6 +810,41 @@ Fortunately, GHC.Core.Opt.Arity gives 'foo' arity 2, which is enough for LetDown forward plusInt's demand signature, and all is well (see Note [Newtype arity] in GHC.Core.Opt.Arity)! A small example is the test case NewtypeArity. +Note [Absence analysis for stable unfoldings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Ticket #18638 shows that it's really important to do absence analysis +for stable unfoldings. Consider + + g = blah + + f = \x. ...no use of g.... + {- f's stable unfolding is f = \x. ...g... -} + +If f is ever inlined we use 'g'. But f's current RHS makes no use +of 'g', so if we don't look at the unfolding we'll mark g as Absent, +and transform to + + g = error "Entered absent value" + f = \x. ... + {- f's stable unfolding is f = \x. ...g... -} + +Now if f is subsequently inlined, we'll use 'g' and ... disaster. + +SOLUTION: if f has a stable unfolding, do demand analysis on its +body. (We dicard the resulting term, using only the DmdType, +specifically the DmdEnv which captures uses of the free variables. + +PS: You may wonder how it can be that f's optimised RHS has somehow +discarded 'g', but when f is inlined we /don't/ discard g in the same +way. I think a simple example is + g = (a,b) + f = \x. fst g + {-# INLNE f #-} + +Now f's optimised RHS will be \x.a, but if we change g to (error "..") +(since it is apparently Absent) and then inline (\x. fst g) we get +disaster. But regardless, #18638 was a more complicated version of +this, that actually happened in practice. Historical Note [Product demands for function body] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Data/OrdList.hs ===================================== @@ -5,13 +5,16 @@ -} {-# LANGUAGE DeriveFunctor #-} - {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE UnboxedSums #-} +{-# LANGUAGE UnboxedTuples #-} -- | Provide trees (of instructions), so that lists of instructions can be -- appended in linear time. module GHC.Data.OrdList ( - OrdList, + OrdList, pattern NilOL, pattern ConsOL, pattern SnocOL, nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL, lastOL, headOL, mapOL, fromOL, toOL, foldrOL, foldlOL, reverseOL, fromOLReverse, @@ -79,6 +82,50 @@ snocOL as b = Snoc as b consOL a bs = Cons a bs concatOL aas = foldr appOL None aas +pattern NilOL :: OrdList a +pattern NilOL <- (isNilOL -> True) where + NilOL = None + +-- | An unboxed 'Maybe' type with two unboxed fields in the 'Just' case. +-- Useful for defining 'viewCons' and 'viewSnoc' without overhead. +type VMaybe a b = (# (# a, b #) | (# #) #) +pattern VJust :: a -> b -> VMaybe a b +pattern VJust a b = (# (# a, b #) | #) +pattern VNothing :: VMaybe a b +pattern VNothing = (# | (# #) #) +{-# COMPLETE VJust, VNothing #-} + +pattern ConsOL :: a -> OrdList a -> OrdList a +pattern ConsOL x xs <- (viewCons -> VJust x xs) where + ConsOL x xs = consOL x xs +{-# COMPLETE NilOL, ConsOL #-} +viewCons :: OrdList a -> VMaybe a (OrdList a) +viewCons (One a) = VJust a NilOL +viewCons (Cons a as) = VJust a as +viewCons (Snoc as a) = case viewCons as of + VJust a' as' -> VJust a' (Snoc as' a) + VNothing -> VJust a NilOL +viewCons (Two as1 as2) = case viewCons as1 of + VJust a' as1' -> VJust a' (Two as1' as2) + VNothing -> viewCons as2 +viewCons _ = VNothing + +pattern SnocOL :: OrdList a -> a -> OrdList a +pattern SnocOL xs x <- (viewSnoc -> VJust xs x) where + SnocOL xs x = snocOL xs x +{-# COMPLETE NilOL, SnocOL #-} +viewSnoc :: OrdList a -> VMaybe (OrdList a) a +viewSnoc (One a) = VJust NilOL a +viewSnoc (Many (reverse -> a:as)) = VJust (Many (reverse as)) a +viewSnoc (Snoc as a) = VJust as a +viewSnoc (Cons a as) = case viewSnoc as of + VJust as' a' -> VJust (Cons a as') a' + VNothing -> VJust NilOL a +viewSnoc (Two as1 as2) = case viewSnoc as2 of + VJust as2' a' -> VJust (Two as1 as2') a' + VNothing -> viewSnoc as1 +viewSnoc _ = VNothing + headOL None = panic "headOL" headOL (One a) = a headOL (Many as) = head as @@ -189,5 +236,3 @@ strictlyOrdOL (Two a1 a2) (Two b1 b2) = strictlyOrdOL (Two _ _) _ = LT strictlyOrdOL (Many as) (Many bs) = compare as bs strictlyOrdOL (Many _ ) _ = GT - - ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -33,7 +33,7 @@ import {-# SOURCE #-} GHC.HsToCore.Match ( matchWrapper ) import GHC.HsToCore.Monad import GHC.HsToCore.GuardedRHSs import GHC.HsToCore.Utils -import GHC.HsToCore.PmCheck ( addTyCsDs, checkGRHSs ) +import GHC.HsToCore.PmCheck ( addTyCs, covCheckGRHSs ) import GHC.Hs -- lots of things import GHC.Core -- lots of things @@ -152,14 +152,14 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun , fun_matches = matches , fun_ext = co_fn , fun_tick = tick }) - = do { (args, body) <- addTyCsDs FromSource (hsWrapDictBinders co_fn) $ + = do { (args, body) <- addTyCs FromSource (hsWrapDictBinders co_fn) $ -- FromSource might not be accurate (we don't have any -- origin annotations for things in this module), but at -- worst we do superfluous calls to the pattern match -- oracle. - -- addTyCsDs: Add type evidence to the refinement type + -- addTyCs: Add type evidence to the refinement type -- predicate of the coverage checker - -- See Note [Type and Term Equality Propagation] in "GHC.HsToCore.PmCheck" + -- See Note [Long-distance information] in "GHC.HsToCore.PmCheck" matchWrapper (mkPrefixFunRhs (L loc (idName fun))) Nothing matches @@ -185,7 +185,7 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = ty , pat_ticks = (rhs_tick, var_ticks) }) - = do { rhss_deltas <- checkGRHSs PatBindGuards grhss + = do { rhss_deltas <- covCheckGRHSs PatBindGuards grhss ; body_expr <- dsGuarded grhss ty rhss_deltas ; let body' = mkOptTickBox rhs_tick body_expr pat' = decideBangHood dflags pat @@ -201,11 +201,11 @@ dsHsBind dflags (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts , abs_exports = exports , abs_ev_binds = ev_binds , abs_binds = binds, abs_sig = has_sig }) - = do { ds_binds <- addTyCsDs FromSource (listToBag dicts) $ + = do { ds_binds <- addTyCs FromSource (listToBag dicts) $ dsLHsBinds binds - -- addTyCsDs: push type constraints deeper + -- addTyCs: push type constraints deeper -- for inner pattern match check - -- See Check, Note [Type and Term Equality Propagation] + -- See Check, Note [Long-distance information] ; ds_ev_binds <- dsTcEvBinds_s ev_binds ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -31,7 +31,7 @@ import GHC.HsToCore.ListComp import GHC.HsToCore.Utils import GHC.HsToCore.Arrows import GHC.HsToCore.Monad -import GHC.HsToCore.PmCheck ( addTyCsDs, checkGRHSs ) +import GHC.HsToCore.PmCheck ( addTyCs, covCheckGRHSs ) import GHC.Types.Name import GHC.Types.Name.Env import GHC.Core.FamInstEnv( topNormaliseType ) @@ -215,7 +215,7 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss , pat_ext = ty }) body = -- let C x# y# = rhs in body -- ==> case rhs of C x# y# -> body - do { match_deltas <- checkGRHSs PatBindGuards grhss + do { match_deltas <- covCheckGRHSs PatBindGuards grhss ; rhs <- dsGuarded grhss ty match_deltas ; let upat = unLoc pat eqn = EqnInfo { eqn_pats = [upat], @@ -283,7 +283,7 @@ dsExpr hswrap@(XExpr (WrapExpr (HsWrap co_fn e))) HsConLikeOut _ (RealDataCon dc) -> return $ varToCoreExpr (dataConWrapId dc) XExpr (WrapExpr (HsWrap _ _)) -> pprPanic "dsExpr: HsWrap inside HsWrap" (ppr hswrap) HsPar _ _ -> pprPanic "dsExpr: HsPar inside HsWrap" (ppr hswrap) - _ -> addTyCsDs FromSource (hsWrapDictBinders co_fn) $ + _ -> addTyCs FromSource (hsWrapDictBinders co_fn) $ dsExpr e -- See Note [Detecting forced eta expansion] ; wrap' <- dsHsWrapper co_fn @@ -486,7 +486,7 @@ dsExpr (HsMultiIf res_ty alts) | otherwise = do { let grhss = GRHSs noExtField alts (noLoc emptyLocalBinds) - ; rhss_deltas <- checkGRHSs IfAlt grhss + ; rhss_deltas <- covCheckGRHSs IfAlt grhss ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_deltas ; error_expr <- mkErrorExpr ; extractMatchResult match_result error_expr } @@ -981,7 +981,7 @@ dsDo ctx stmts = do { body <- goL stmts ; rhs' <- dsLExpr rhs ; var <- selectSimpleMatchVarL (xbstc_boundResultMult xbs) pat - ; match <- matchSinglePatVar var (StmtCtxt ctx) pat + ; match <- matchSinglePatVar var Nothing (StmtCtxt ctx) pat (xbstc_boundResultType xbs) (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure ctx pat match (xbstc_failOp xbs) ; dsSyntaxExpr (xbstc_bindOp xbs) [rhs', Lam var match_code] } @@ -1002,7 +1002,7 @@ dsDo ctx stmts ; let match_args (pat, fail_op) (vs,body) = do { var <- selectSimpleMatchVarL Many pat - ; match <- matchSinglePatVar var (StmtCtxt ctx) pat + ; match <- matchSinglePatVar var Nothing (StmtCtxt ctx) pat body_ty (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure ctx pat match fail_op ; return (var:vs, match_code) ===================================== compiler/GHC/HsToCore/GuardedRHSs.hs ===================================== @@ -36,7 +36,7 @@ import Control.Monad ( zipWithM ) import Data.List.NonEmpty ( NonEmpty, toList ) {- - at dsGuarded@ is used for pattern bindings. + at dsGuarded@ is used for GRHSs. It desugars: \begin{verbatim} | g1 -> e1 @@ -44,7 +44,7 @@ It desugars: | gn -> en where binds \end{verbatim} -producing an expression with a runtime error in the corner if +producing an expression with a runtime error in the corner case if necessary. The type argument gives the type of the @ei at . -} @@ -137,8 +137,8 @@ matchGuards (BindStmt _ pat bind_rhs : stmts) ctx deltas rhs rhs_ty = do match_result <- matchGuards stmts ctx deltas rhs rhs_ty core_rhs <- dsLExpr bind_rhs - match_result' <- matchSinglePatVar match_var (StmtCtxt ctx) pat rhs_ty - match_result + match_result' <- matchSinglePatVar match_var (Just core_rhs) (StmtCtxt ctx) + pat rhs_ty match_result pure $ bindNonRec match_var core_rhs <$> match_result' matchGuards (LastStmt {} : _) _ _ _ _ = panic "matchGuards LastStmt" ===================================== compiler/GHC/HsToCore/ListComp.hs ===================================== @@ -617,7 +617,7 @@ dsMcBindStmt :: LPat GhcTc dsMcBindStmt pat rhs' bind_op fail_op res1_ty stmts = do { body <- dsMcStmts stmts ; var <- selectSimpleMatchVarL Many pat - ; match <- matchSinglePatVar var (StmtCtxt (DoExpr Nothing)) pat + ; match <- matchSinglePatVar var Nothing (StmtCtxt (DoExpr Nothing)) pat res1_ty (cantFailMatchResult body) ; match_code <- dsHandleMonadicFailure (MonadComp :: HsStmtContext GhcRn) pat match fail_op ; dsSyntaxExpr bind_op [rhs', Lam var match_code] } ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -66,7 +66,7 @@ import GHC.Data.FastString import GHC.Types.Unique import GHC.Types.Unique.DFM -import Control.Monad(zipWithM, unless ) +import Control.Monad ( zipWithM, unless, when ) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NEL import qualified Data.Map as Map @@ -769,9 +769,9 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches -- @rhss_deltas@ is a flat list of covered Deltas for each RHS. -- Each Match will split off one Deltas for its RHSs from this. ; matches_deltas <- if isMatchContextPmChecked dflags origin ctxt - then addScrutTmCs mb_scr new_vars $ - -- See Note [Type and Term Equality Propagation] - checkMatches (DsMatchContext ctxt locn) new_vars matches + then addHsScrutTmCs mb_scr new_vars $ + -- See Note [Long-distance information] + covCheckMatches (DsMatchContext ctxt locn) new_vars matches else pure (initDeltasMatches matches) ; eqns_info <- zipWithM mk_eqn_info matches matches_deltas @@ -820,25 +820,24 @@ matchEquations ctxt vars eqns_info rhs_ty ; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_doc ; extractMatchResult match_result fail_expr } -{- -************************************************************************ -* * -\subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern} -* * -************************************************************************ - - at mkSimpleMatch@ is a wrapper for @match@ which deals with the -situation where we want to match a single expression against a single -pattern. It returns an expression. --} - +-- | @matchSimply@ is a wrapper for 'match' which deals with the +-- situation where we want to match a single expression against a single +-- pattern. It returns an expression. matchSimply :: CoreExpr -- ^ Scrutinee -> HsMatchContext GhcRn -- ^ Match kind -> LPat GhcTc -- ^ Pattern it should match -> CoreExpr -- ^ Return this if it matches -> CoreExpr -- ^ Return this if it doesn't -> DsM CoreExpr --- Do not warn about incomplete patterns; see matchSinglePat comments +-- Some reasons 'matchSimply' is not defined using 'matchWrapper' (#18572): +-- * Some call sites like in 'deBindComp' specify a @fail_expr@ that isn't a +-- straight @patError@ +-- * It receives an already desugared 'CoreExpr' for the scrutinee, not an +-- 'HsExpr' like 'matchWrapper' expects +-- * Filling in all the phony fields for the 'MatchGroup' for a single pattern +-- match is awkward +-- * And we still export 'matchSinglePatVar', so not much is gained if we +-- don't also implement it in terms of 'matchWrapper' matchSimply scrut hs_ctx pat result_expr fail_expr = do let match_result = cantFailMatchResult result_expr @@ -858,7 +857,7 @@ matchSinglePat :: CoreExpr -> HsMatchContext GhcRn -> LPat GhcTc matchSinglePat (Var var) ctx pat ty match_result | not (isExternalName (idName var)) - = matchSinglePatVar var ctx pat ty match_result + = matchSinglePatVar var Nothing ctx pat ty match_result matchSinglePat scrut hs_ctx pat ty match_result = do { var <- selectSimpleMatchVarL Many pat @@ -867,22 +866,22 @@ matchSinglePat scrut hs_ctx pat ty match_result -- and to create field selectors. All of which only -- bind unrestricted variables, hence the 'Many' -- above. - ; match_result' <- matchSinglePatVar var hs_ctx pat ty match_result + ; match_result' <- matchSinglePatVar var (Just scrut) hs_ctx pat ty match_result ; return $ bindNonRec var scrut <$> match_result' } matchSinglePatVar :: Id -- See Note [Match Ids] + -> Maybe CoreExpr -- ^ The scrutinee the match id is bound to -> HsMatchContext GhcRn -> LPat GhcTc -> Type -> MatchResult CoreExpr -> DsM (MatchResult CoreExpr) -matchSinglePatVar var ctx pat ty match_result +matchSinglePatVar var mb_scrut ctx pat ty match_result = ASSERT2( isInternalName (idName var), ppr var ) do { dflags <- getDynFlags ; locn <- getSrcSpanDs - -- Pattern match check warnings - ; if isMatchContextPmChecked dflags FromSource ctx - then checkSingle dflags (DsMatchContext ctx locn) var (unLoc pat) - else pure () + ; when (isMatchContextPmChecked dflags FromSource ctx) $ + addCoreScrutTmCs mb_scrut [var] $ + covCheckPatBind (DsMatchContext ctx locn) var (unLoc pat) ; let eqn_info = EqnInfo { eqn_pats = [unLoc (decideBangHood dflags pat)] , eqn_orig = FromSource ===================================== compiler/GHC/HsToCore/Match.hs-boot ===================================== @@ -29,6 +29,7 @@ matchSimply matchSinglePatVar :: Id + -> Maybe CoreExpr -> HsMatchContext GhcRn -> LPat GhcTc -> Type ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -1,24 +1,51 @@ -{- -Author: George Karachalias - -Pattern Matching Coverage Checking. --} - -{-# LANGUAGE CPP #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} - +{-# LANGUAGE CPP #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE FlexibleInstances #-} + +-- | This module coverage checks pattern matches. It finds +-- +-- * Uncovered patterns, certifying non-exhaustivity +-- * Redundant equations +-- * Equations with an inaccessible right-hand-side +-- +-- The algorithm is based on the paper +-- [Lower Your Guards: A Compositional Pattern-Match Coverage Checker"](https://dl.acm.org/doi/abs/10.1145/3408989) +-- +-- There is an overview Figure 2 in there that's probably helpful. +-- Here is an overview of how it's implemented, which follows the structure of +-- the entry points such as 'covCheckMatches': +-- +-- 1. Desugar source syntax (like 'LMatch') to guard tree variants (like +-- 'GrdMatch'), with one of the desugaring functions (like 'desugarMatch'). +-- Follows Section 3.1 in the paper. +-- 2. Coverage check guard trees (with a function like 'checkMatch') to get a +-- 'CheckResult', containing +-- a. The set of uncovered values, 'cr_uncov' +-- b. And an annotated tree variant (like 'AnnMatch') that captures +-- redundancy and inaccessibility information as 'RedSets' annotations +-- Basically the UA function from Section 5.1. The Normalised Refinement Types +-- Nabla are modeled as 'Deltas' and checked in "GHC.HsToCore.PmCheck.Oracle". +-- 3. Collect redundancy information into a 'CIRB' with a function such +-- as 'cirbsMatch'. Follows the R function from Figure 6 of the paper. +-- 4. Format and report uncovered patterns and redundant equations ('CIRB') +-- with 'formatReportWarnings'. Basically job of the G function, plus proper +-- pretty printing of the warnings (Section 5.4 of the paper). +-- 5. Return 'Deltas' reaching syntactic sub-components for +-- Note [Long-distance information]. Collected by functions such as +-- 'ldiMatch'. See Section 4.1 of the paper. module GHC.HsToCore.PmCheck ( -- Checking and printing - checkSingle, checkMatches, checkGRHSs, + covCheckPatBind, covCheckMatches, covCheckGRHSs, isMatchContextPmChecked, - -- See Note [Type and Term Equality Propagation] - addTyCsDs, addScrutTmCs + -- See Note [Long-distance information] + addTyCs, addCoreScrutTmCs, addHsScrutTmCs ) where #include "HsVersions.h" @@ -37,7 +64,6 @@ import GHC.Tc.Utils.Zonk (shortCutLit) import GHC.Types.Id import GHC.Core.ConLike import GHC.Types.Name -import GHC.Tc.Instance.Family import GHC.Builtin.Types import GHC.Types.SrcLoc import GHC.Utils.Misc @@ -62,35 +88,148 @@ import GHC.Core.Type import GHC.HsToCore.Utils (isTrueLHsExpr) import GHC.Data.Maybe import qualified GHC.LanguageExtensions as LangExt -import GHC.Utils.Monad (concatMapM) +import GHC.Utils.Monad (concatMapM, mapMaybeM) import Control.Monad (when, forM_, zipWithM) import Data.List (elemIndex) import qualified Data.Semigroup as Semi -import Data.List.NonEmpty (NonEmpty(..)) +import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE +import Data.Coerce -{- -This module checks pattern matches for: -\begin{enumerate} - \item Equations that are redundant - \item Equations with inaccessible right-hand-side - \item Exhaustiveness -\end{enumerate} +-- +-- * Exported entry points to the checker +-- -The algorithm is based on the paper: +-- | A non-empty delta that is initialised from the ambient refinement type +-- capturing long-distance information, or the trivially habitable 'Deltas' if +-- the former is uninhabited. +-- See Note [Recovering from unsatisfiable pattern-matching constraints]. +getLdiDeltas :: DsM Deltas +getLdiDeltas = do + deltas <- getPmDeltas + isInhabited deltas >>= \case + True -> pure deltas + False -> pure initDeltas + +-- | Check a pattern binding (let, where) for exhaustiveness. +covCheckPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () +-- See Note [covCheckPatBind only checks PatBindRhs] +covCheckPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do + missing <- getLdiDeltas + pat_bind <- desugarPatBind loc var p + tracePm "covCheckPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) + result <- unCA (checkPatBind pat_bind) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsPatBind ctxt [var] result +covCheckPatBind _ _ _ = pure () + +-- | Exhaustive for guard matches, is used for guards in pattern bindings and +-- in @MultiIf@ expressions. Returns the 'Deltas' covered by the RHSs. +covCheckGRHSs + :: HsMatchContext GhcRn -- ^ Match context, for warning messages + -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check + -> DsM (NonEmpty Deltas) -- ^ Covered 'Deltas' for each RHS, for long + -- distance info +covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do + let combined_loc = foldl1 combineSrcSpans (map getLoc grhss) + ctxt = DsMatchContext hs_ctxt combined_loc + matches <- desugarGRHSs combined_loc empty guards + missing <- getLdiDeltas + tracePm "covCheckGRHSs" (hang (vcat [ppr ctxt + , text "Guards:"]) + 2 + (pprGRHSs hs_ctxt guards $$ ppr missing)) + result <- unCA (checkGRHSs matches) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsGRHSs ctxt [] result + return (ldiGRHS <$> cr_ret result) + +-- | Check a list of syntactic 'Match'es (part of case, functions, etc.), each +-- with a 'Pat' and one or more 'GRHSs': +-- +-- @ +-- f x y | x == y = 1 -- match on x and y with two guarded RHSs +-- | otherwise = 2 +-- f _ _ = 3 -- clause with a single, un-guarded RHS +-- @ +-- +-- Returns one non-empty 'Deltas' for 1.) each pattern of a 'Match' and 2.) +-- each of a 'Match'es 'GRHS' for Note [Long-distance information]. +-- +-- Special case: When there are /no matches/, then the functionassumes it +-- checks and @-XEmptyCase@ with only a single match variable. +-- See Note [Checking EmptyCase]. +covCheckMatches + :: DsMatchContext -- ^ Match context, for warnings messages + -> [Id] -- ^ Match variables, i.e. x and y above + -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches + -> DsM [(Deltas, NonEmpty Deltas)] -- ^ One covered 'Deltas' per Match and + -- GRHS, for long distance info. +covCheckMatches ctxt vars matches = do + -- We have to force @missing@ before printing out the trace message, + -- otherwise we get interleaved output from the solver. This function + -- should be strict in @missing@ anyway! + !missing <- getLdiDeltas + tracePm "covCheckMatches {" $ + hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) + 2 + (vcat (map ppr matches) $$ ppr missing) + case NE.nonEmpty matches of + Nothing -> do + -- This must be an -XEmptyCase. See Note [Checking EmptyCase] + let var = only vars + empty_case <- desugarEmptyCase var + result <- unCA (checkEmptyCase empty_case) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsEmptyCase ctxt vars result + return [] + Just matches -> do + matches <- desugarMatches vars matches + result <- unCA (checkMatchGroup matches) missing + tracePm "}: " (ppr (cr_uncov result)) + formatReportWarnings cirbsMatchGroup ctxt vars result + return (NE.toList (ldiMatchGroup (cr_ret result))) + +{- Note [covCheckPatBind only checks PatBindRhs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + at covCheckPatBind@'s sole purpose is to check vanilla pattern bindings, like + at x :: Int; Just x = e@, which is in a @PatBindRhs@ context. +But its caller is also called for individual pattern guards in a @StmtCtxt at . +For example, both pattern guards in @f x y | True <- x, False <- y = ...@ will +go through this function. It makes no sense to do coverage checking there: + * Pattern guards may well fail. Fall-through is not an unrecoverable panic, + but rather behavior the programmer expects, so inexhaustivity should not be + reported. + * Redundancy is already reported for the whole GRHS via one of the other + exported coverage checking functions. Also reporting individual redundant + guards is... redundant. See #17646. +Note that we can't just omit checking of @StmtCtxt@ altogether (by adjusting +'isMatchContextPmChecked'), because that affects the other checking functions, +too. + +Note [Checking EmptyCase] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-XEmptyCase is useful for matching on empty data types like 'Void'. For example, +the following is a complete match: - "GADTs Meet Their Match: - Pattern-matching Warnings That Account for GADTs, Guards, and Laziness" + f :: Void -> () + f x = case x of {} - https://www.microsoft.com/en-us/research/wp-content/uploads/2016/08/gadtpm-acm.pdf +Really, -XEmptyCase is the only way to write a program that at the same time is +safe (@f _ = error "boom"@ is not because of ⊥), doesn't trigger a warning +(@f !_ = error "inaccessible" has inaccessible RHS) and doesn't turn an +exception into divergence (@f x = f x@). -%************************************************************************ -%* * - Pattern Match Check Types -%* * -%************************************************************************ +Semantically, unlike every other case expression, -XEmptyCase is strict in its +match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the +initial Delta and check if there are any values left to match on. -} +-- +-- * Guard language +-- + -- | A very simple language for pattern guards. Let bindings, bang patterns, -- and matching variables against flat constructor patterns. data PmGrd @@ -106,9 +245,9 @@ data PmGrd } -- | @PmBang x@ corresponds to a @seq x True@ guard. - -- If the extra SrcInfo is present, the bang guard came from a source - -- bang pattern, in which case we might want to report it as redundant, - -- see Note [Dead bang patterns]. + -- If the extra 'SrcInfo' is present, the bang guard came from a source + -- bang pattern, in which case we might want to report it as redundant. + -- See Note [Dead bang patterns]. | PmBang { pm_id :: !Id, pm_loc :: !(Maybe SrcInfo) @@ -144,24 +283,115 @@ instance Monoid Precision where mempty = Precise mappend = (Semi.<>) --- | Means by which we identify source location for later pretty-printing --- in a warning message. 'SDoc' for the equation to show, 'Located' for --- the location. +-- +-- * Guard tree language +-- + +-- | Means by which we identify a source construct for later pretty-printing in +-- a warning message. 'SDoc' for the equation to show, 'Located' for the +-- location. type SrcInfo = Located SDoc --- | A representation of the desugaring to 'PmGrd's of all clauses of a --- function definition/pattern match/etc. -data GrdTree - = Rhs !SrcInfo - | Guard !PmGrd !GrdTree - -- ^ @Guard grd t@ will try to match @grd@ and on success continue to match - -- @t at . Falls through if either match fails. Models left-to-right semantics - -- of pattern matching. - | Sequence ![GrdTree] - -- ^ @Sequence (t:ts)@ matches against @t@, and then matches all - -- fallen-through values against @Sequence ts at . Models top-to-bottom semantics - -- of pattern matching. - -- @Sequence []@ always fails; it is useful for Note [Checking EmptyCase]. +-- | Redundancy sets, used to determine redundancy of RHSs and bang patterns +-- (later digested into a 'CIRB'). +data RedSets + = RedSets + { rs_cov :: !Deltas + -- ^ The /Covered/ set; the set of values reaching a particular program + -- point. + , rs_div :: !Deltas + -- ^ The /Diverging/ set; empty if no match can lead to divergence. + -- If it wasn't empty, we have to turn redundancy warnings into + -- inaccessibility warnings for any subclauses. + , rs_bangs :: !(OrdList (Deltas, SrcInfo)) + -- ^ If any of the 'Deltas' is empty, the corresponding 'SrcInfo' pin-points + -- a bang pattern in source that is redundant. See Note [Dead bang patterns]. + } + +-- The following two type synonyms instantiate our tree structures to guard +-- trees and annotated trees, respectively, by giving the types to attach as +-- payload. + +-- | Used as tree payload pre-checking. The LYG guards to check. +type Pre = [PmGrd] + +-- | Used as tree payload post-checking. The redundancy info we elaborated. +type Post = RedSets + +-- | A guard tree denoting 'MatchGroup'. +newtype PmMatchGroup p = PmMatchGroup (NonEmpty (PmMatch p)) + +-- | A guard tree denoting 'Match': A payload describing the pats and a bunch of +-- GRHS. +data PmMatch p = PmMatch { pm_pats :: !p, pm_grhss :: !(NonEmpty (PmGRHS p)) } + +-- | A guard tree denoting 'GRHS': A payload describing the grds and a 'SrcInfo' +-- useful for printing out in warnings messages. +data PmGRHS p = PmGRHS { pg_grds :: !p, pg_rhs :: !SrcInfo } + +-- | A guard tree denoting an -XEmptyCase. +newtype PmEmptyCase = PmEmptyCase { pe_var :: Id } + +-- | A guard tree denoting a pattern binding. +newtype PmPatBind p = + -- just reuse GrdGRHS and pretend its @SrcInfo@ is info on the /pattern/, + -- rather than on the pattern bindings. + PmPatBind (PmGRHS p) + +emptyRedSets :: RedSets +-- Semigroup instance would be misleading! +emptyRedSets = RedSets mempty mempty mempty + +pprSrcInfo :: SrcInfo -> SDoc +pprSrcInfo (L (RealSrcSpan rss _) _) = ppr (srcSpanStartLine rss) +pprSrcInfo (L s _) = ppr s + +-- | Format LYG guards as @| True <- x, let x = 42, !z@ +pprLygGuards :: [PmGrd] -> SDoc +pprLygGuards [] = empty +pprLygGuards (g:gs) = fsep (char '|' <+> ppr g : map ((comma <+>) . ppr) gs) + +-- | Format a LYG sequence (e.g. 'Match'es of a 'MatchGroup' or 'GRHSs') as +-- @{ ; ...; }@ +pprLygSequence :: Outputable a => NonEmpty a -> SDoc +pprLygSequence (NE.toList -> as) = + braces (space <> fsep (punctuate semi (map ppr as)) <> space) + +instance Outputable (PmMatchGroup Pre) where + ppr (PmMatchGroup matches) = pprLygSequence matches + +instance Outputable (PmMatch Pre) where + ppr (PmMatch { pm_pats = grds, pm_grhss = grhss }) = + pprLygGuards grds <+> ppr grhss + +instance Outputable (PmGRHS Pre) where + ppr (PmGRHS { pg_grds = grds, pg_rhs = rhs }) = + pprLygGuards grds <+> text "->" <+> pprSrcInfo rhs + +instance Outputable (PmPatBind Pre) where + ppr (PmPatBind PmGRHS { pg_grds = grds, pg_rhs = bind }) = + ppr bind <+> pprLygGuards grds <+> text "=" <+> text "..." + +instance Outputable PmEmptyCase where + ppr (PmEmptyCase { pe_var = var }) = + text " ppr var <> text ">" + +pprRedSets :: RedSets -> SDoc +-- It's useful to change this definition for different verbosity levels in +-- printf-debugging +pprRedSets RedSets { rs_cov = _cov, rs_div = _div, rs_bangs = _bangs } + = empty + +instance Outputable (PmMatchGroup Post) where + ppr (PmMatchGroup matches) = pprLygSequence matches + +instance Outputable (PmMatch Post) where + ppr (PmMatch { pm_pats = red, pm_grhss = grhss }) = + pprRedSets red <+> ppr grhss + +instance Outputable (PmGRHS Post) where + ppr (PmGRHS { pg_grds = red, pg_rhs = rhs }) = + pprRedSets red <+> text "->" <+> pprSrcInfo rhs {- Note [Dead bang patterns] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -178,7 +408,7 @@ that under no circumstances can force a thunk that wasn't already forced. Dead bangs are a form of redundant bangs; see below. We can detect dead bang patterns by checking whether @x ~ ⊥@ is satisfiable -where the PmBang appears in 'checkGrdTree'. If not, then clearly the bang is +where the PmBang appears in 'checkGrd'. If not, then clearly the bang is dead. Such a dead bang is then indicated in the annotated pattern-match tree by a 'RedundantSrcBang' wrapping. In 'redundantAndInaccessibles', we collect all dead bangs to warn about. @@ -197,235 +427,9 @@ it is redundant with the forcing done by the () match. We currently don't detect redundant bangs that aren't dead. -} --- | The digest of 'checkGrdTree', representing the annotated pattern-match --- tree. 'extractRedundancyInfo' can figure out redundant and proper --- inaccessible RHSs from this, as well as dead bangs. -data AnnotatedTree - = AccessibleRhs !Deltas !SrcInfo - -- ^ A RHS deemed accessible. The 'Deltas' is the (non-empty) set of covered - -- values. - | InaccessibleRhs !SrcInfo - -- ^ A RHS deemed inaccessible; it covers no value. - | MayDiverge !AnnotatedTree - -- ^ Asserts that the tree may force diverging values, so not all of its - -- clauses can be redundant. - | SequenceAnn !Deltas ![AnnotatedTree] - -- ^ @SequenceAnn inc ts@ mirrors @'Sequence' ts@ for preserving the - -- skeleton of a 'GrdTree's @ts at . It also carries the set of incoming values - -- @inc at . - | RedundantSrcBang !SrcInfo !AnnotatedTree - -- ^ For tracking redundant bangs. See Note [Dead bang patterns] - -pprSrcInfo :: SrcInfo -> SDoc -pprSrcInfo (L (RealSrcSpan rss _) _) = ppr (srcSpanStartLine rss) -pprSrcInfo (L s _) = ppr s - -instance Outputable GrdTree where - ppr (Rhs info) = text "->" <+> pprSrcInfo info - -- Format guards as "| True <- x, let x = 42, !z" - ppr g at Guard{} = fsep (prefix (map ppr grds)) <+> ppr t - where - (t, grds) = collect_grds g - collect_grds (Guard grd t) = (grd :) <$> collect_grds t - collect_grds t = (t, []) - prefix [] = [] - prefix (s:sdocs) = char '|' <+> s : map (comma <+>) sdocs - ppr (Sequence []) = text "" - ppr (Sequence ts) = braces (space <> fsep (punctuate semi (map ppr ts)) <> space) - -instance Outputable AnnotatedTree where - ppr (AccessibleRhs _delta info) = parens (ppr _delta) <+> pprSrcInfo info - ppr (InaccessibleRhs info) = text "inaccessible" <+> pprSrcInfo info - ppr (MayDiverge t) = text "div" <+> ppr t - ppr (SequenceAnn _ []) = text "" - ppr (SequenceAnn _ ts) = braces (space <> fsep (punctuate semi (map ppr ts)) <> space) - ppr (RedundantSrcBang l t) = text "redundant bang" <+> pprSrcInfo l <+> ppr t - --- | Lift 'addPmCts' over 'Deltas'. -addPmCtsDeltas :: Deltas -> PmCts -> DsM Deltas -addPmCtsDeltas deltas cts = liftDeltasM (\d -> addPmCts d cts) deltas - --- | 'addPmCtsDeltas' a single 'PmCt'. -addPmCtDeltas :: Deltas -> PmCt -> DsM Deltas -addPmCtDeltas deltas ct = addPmCtsDeltas deltas (unitBag ct) - --- | Test if any of the 'Delta's is inhabited. Currently this is pure, because --- we preserve the invariant that there are no uninhabited 'Delta's. But that --- could change in the future, for example by implementing this function in --- terms of @notNull <$> provideEvidence 1 ds at . -isInhabited :: Deltas -> DsM Bool -isInhabited (MkDeltas ds) = pure (not (null ds)) - --- | Pattern-match check result -data CheckResult - = CheckResult - { cr_clauses :: !AnnotatedTree - -- ^ Captures redundancy info for each clause in the original program. - -- (for -Woverlapping-patterns) - , cr_uncov :: !Deltas - -- ^ The set of uncovered values falling out at the bottom. - -- (for -Wincomplete-patterns) - , cr_approx :: !Precision - -- ^ A flag saying whether we ran into the 'maxPmCheckModels' limit for the - -- purpose of suggesting to crank it up in the warning message - } - -instance Outputable CheckResult where - ppr (CheckResult c unc pc) - = text "CheckResult" <+> ppr_precision pc <+> braces (fsep - [ field "clauses" c <> comma - , field "uncov" unc]) - where - ppr_precision Precise = empty - ppr_precision Approximate = text "(Approximate)" - field name value = text name <+> equals <+> ppr value - -{- -%************************************************************************ -%* * - Entry points to the checker: checkSingle and checkMatches -%* * -%************************************************************************ --} - --- | Check a single pattern binding (let) for exhaustiveness. -checkSingle :: DynFlags -> DsMatchContext -> Id -> Pat GhcTc -> DsM () -checkSingle dflags ctxt@(DsMatchContext kind locn) var p = do - tracePm "checkSingle" (vcat [ppr ctxt, ppr var, ppr p]) - -- We only ever need to run this in a context where we need exhaustivity - -- warnings (so not in pattern guards or comprehensions, for example, because - -- they are perfectly fine to fail). - -- Omitting checking this flag emits redundancy warnings twice in obscure - -- cases like #17646. - when (exhaustive dflags kind) $ do - -- TODO: This could probably call checkMatches, like checkGRHSs. - missing <- getPmDeltas - tracePm "checkSingle: missing" (ppr missing) - fam_insts <- dsGetFamInstEnvs - grd_tree <- mkGrdTreeRhs (L locn $ ppr p) <$> translatePat fam_insts var p - res <- checkGrdTree grd_tree missing - dsPmWarn dflags ctxt [var] res - --- | Exhaustive for guard matches, is used for guards in pattern bindings and --- in @MultiIf@ expressions. Returns the 'Deltas' covered by the RHSs. -checkGRHSs - :: HsMatchContext GhcRn -- ^ Match context, for warning messages - -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check - -> DsM (NonEmpty Deltas) -- ^ Covered 'Deltas' for each RHS, for long - -- distance info -checkGRHSs hs_ctx guards@(GRHSs _ grhss _) = do - let combinedLoc = foldl1 combineSrcSpans (map getLoc grhss) - dsMatchContext = DsMatchContext hs_ctx combinedLoc - match = L combinedLoc $ - Match { m_ext = noExtField - , m_ctxt = hs_ctx - , m_pats = [] - , m_grhss = guards } - [(_, deltas)] <- checkMatches dsMatchContext [] [match] - pure deltas - --- | Check a list of syntactic /match/es (part of case, functions, etc.), each --- with a /pat/ and one or more /grhss/: -- --- @ --- f x y | x == y = 1 -- match on x and y with two guarded RHSs --- | otherwise = 2 --- f _ _ = 3 -- clause with a single, un-guarded RHS --- @ +-- * Desugaring source syntax to guard trees -- --- Returns one 'Deltas' for each GRHS, representing its covered values, or the --- incoming uncovered 'Deltas' (from 'getPmDeltas') if the GRHS is inaccessible. --- Since there is at least one /grhs/ per /match/, the list of 'Deltas' is at --- least as long as the list of matches. -checkMatches - :: DsMatchContext -- ^ Match context, for warnings messages - -> [Id] -- ^ Match variables, i.e. x and y above - -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches - -> DsM [(Deltas, NonEmpty Deltas)] -- ^ One covered 'Deltas' per RHS, for long - -- distance info. -checkMatches ctxt vars matches = do - tracePm "checkMatches" (hang (vcat [ppr ctxt - , ppr vars - , text "Matches:"]) - 2 - (vcat (map ppr matches))) - - init_deltas <- getPmDeltas - missing <- case matches of - -- This must be an -XEmptyCase. See Note [Checking EmptyCase] - [] | [var] <- vars -> addPmCtDeltas init_deltas (PmNotBotCt var) - _ -> pure init_deltas - fam_insts <- dsGetFamInstEnvs - grd_tree <- translateMatches fam_insts vars matches - res <- checkGrdTree grd_tree missing - - dflags <- getDynFlags - dsPmWarn dflags ctxt vars res - - return (extractRhsDeltas (cr_clauses res)) - --- | Extract the 'Deltas' reaching the RHSs of the 'AnnotatedTree' for a match --- group. --- For 'AccessibleRhs's, this is stored in the tree node, whereas --- 'InaccessibleRhs's fall back to the supplied original 'Deltas'. --- See @Note [Recovering from unsatisfiable pattern-matching constraints]@. -extractRhsDeltas :: AnnotatedTree -> [(Deltas, NonEmpty Deltas)] -extractRhsDeltas = go_matches - where - go_matches :: AnnotatedTree -> [(Deltas, NonEmpty Deltas)] - go_matches (SequenceAnn def ts) = map (go_match def) ts -- -XEmptyCase handled here! - go_matches t = pprPanic "extractRhsDeltas.go_matches" (text "Matches must start with SequenceAnn. But was" $$ ppr t) - - go_match :: Deltas -> AnnotatedTree -> (Deltas, NonEmpty Deltas) - -- There is no -XEmptyCase at this level, only at the Matches level. So @ts@ - -- is non-empty! - go_match def (SequenceAnn pat ts) = (pat, foldMap1 (text "go_match: empty SequenceAnn") (go_grhss def) ts) - go_match def (MayDiverge t) = go_match def t - go_match def (RedundantSrcBang _ t) = go_match def t - -- Even if there's only a single GRHS, we wrap it in a SequenceAnn for the - -- Deltas covered by the pattern. So the remaining cases are impossible! - go_match _ t = pprPanic "extractRhsDeltas.go_match" (text "Single GRHS must be wrapped in SequenceAnn. But got " $$ ppr t) - - go_grhss :: Deltas -> AnnotatedTree -> NonEmpty Deltas - -- There is no -XEmptyCase at this level, only at the Matches level. So @ts@ - -- is non-empty! - go_grhss def (SequenceAnn _ ts) = foldMap1 (text "go_grhss: empty SequenceAnn") (go_grhss def) ts - go_grhss def (MayDiverge t) = go_grhss def t - go_grhss def (RedundantSrcBang _ t) = go_grhss def t - go_grhss _ (AccessibleRhs deltas _) = deltas :| [] - go_grhss def (InaccessibleRhs _) = def :| [] - - foldMap1 msg _ [] = pprPanic "extractRhsDeltas.foldMap1" msg - foldMap1 _ f (x:xs) = foldl' (\acc x -> acc Semi.<> f x) (f x) xs - -{- Note [Checking EmptyCase] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ --XEmptyCase is useful for matching on empty data types like 'Void'. For example, -the following is a complete match: - - f :: Void -> () - f x = case x of {} - -Really, -XEmptyCase is the only way to write a program that at the same time is -safe (@f _ = error "boom"@ is not because of ⊥), doesn't trigger a warning -(@f !_ = error "inaccessible" has inaccessible RHS) and doesn't turn an -exception into divergence (@f x = f x@). - -Semantically, unlike every other case expression, -XEmptyCase is strict in its -match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the -initial Delta and check if there are any values left to match on. --} - -{- -%************************************************************************ -%* * - Transform source syntax to *our* syntax -%* * -%************************************************************************ --} - --- ----------------------------------------------------------------------- --- * Utilities -- | Smart constructor that eliminates trivial lets mkPmLetVar :: Id -> Id -> GrdVec @@ -458,7 +462,7 @@ mkListGrds a ((x, head_grds):xs) = do -- | Create a 'GrdVec' refining a match variable to a 'PmLit'. mkPmLitGrds :: Id -> PmLit -> DsM GrdVec mkPmLitGrds x (PmLit _ (PmLitString s)) = do - -- We translate String literals to list literals for better overlap reasoning. + -- We desugar String literals to list literals for better overlap reasoning. -- It's a little unfortunate we do this here rather than in -- 'GHC.HsToCore.PmCheck.Oracle.trySolve' and -- 'GHC.HsToCore.PmCheck.Oracle.addRefutableAltCon', but it's so much simpler @@ -476,37 +480,34 @@ mkPmLitGrds x lit = do , pm_con_args = [] } pure [grd] --- ----------------------------------------------------------------------- --- * Transform (Pat Id) into GrdVec - --- | @translatePat _ x pat@ transforms @pat@ into a 'GrdVec', where +-- | @desugarPat _ x pat@ transforms @pat@ into a 'GrdVec', where -- the variable representing the match is @x at . -translatePat :: FamInstEnvs -> Id -> Pat GhcTc -> DsM GrdVec -translatePat fam_insts x pat = case pat of +desugarPat :: Id -> Pat GhcTc -> DsM GrdVec +desugarPat x pat = case pat of WildPat _ty -> pure [] VarPat _ y -> pure (mkPmLetVar (unLoc y) x) - ParPat _ p -> translateLPat fam_insts x p + ParPat _ p -> desugarLPat x p LazyPat _ _ -> pure [] -- like a wildcard BangPat _ p@(L l p') -> -- Add the bang in front of the list, because it will happen before any -- nested stuff. - (PmBang x pm_loc :) <$> translateLPat fam_insts x p - where pm_loc = Just (L l (ppr p')) + (PmBang x pm_loc :) <$> desugarLPat x p + where pm_loc = Just (L l (ppr p')) - -- (x at pat) ==> Translate pat with x as match var and handle impedance + -- (x at pat) ==> Desugar pat with x as match var and handle impedance -- mismatch with incoming match var - AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> translateLPat fam_insts y p + AsPat _ (L _ y) p -> (mkPmLetVar y x ++) <$> desugarLPat y p - SigPat _ p _ty -> translateLPat fam_insts x p + SigPat _ p _ty -> desugarLPat x p - -- See Note [Translate CoPats] + -- See Note [Desugar CoPats] -- Generally the translation is -- pat |> co ===> let y = x |> co, pat <- y where y is a match var of pat XPat (CoPat wrapper p _ty) - | isIdHsWrapper wrapper -> translatePat fam_insts x p - | WpCast co <- wrapper, isReflexiveCo co -> translatePat fam_insts x p + | isIdHsWrapper wrapper -> desugarPat x p + | WpCast co <- wrapper, isReflexiveCo co -> desugarPat x p | otherwise -> do - (y, grds) <- translatePatV fam_insts p + (y, grds) <- desugarPatV p wrap_rhs_y <- dsHsWrapper wrapper pure (PmLet y (wrap_rhs_y (Var x)) : grds) @@ -521,13 +522,13 @@ translatePat fam_insts x pat = case pat of -- (fun -> pat) ===> let y = fun x, pat <- y where y is a match var of pat ViewPat _arg_ty lexpr pat -> do - (y, grds) <- translateLPatV fam_insts pat + (y, grds) <- desugarLPatV pat fun <- dsLExpr lexpr pure $ PmLet y (App fun (Var x)) : grds -- list ListPat (ListPatTc _elem_ty Nothing) ps -> - translateListPat fam_insts x ps + desugarListPat x ps -- overloaded list ListPat (ListPatTc elem_ty (Just (pat_ty, to_list))) pats -> do @@ -535,11 +536,11 @@ translatePat fam_insts x pat = case pat of case splitListTyConApp_maybe pat_ty of Just _e_ty | not (xopt LangExt.RebindableSyntax dflags) - -- Just translate it as a regular ListPat - -> translateListPat fam_insts x pats + -- Just desugar it as a regular ListPat + -> desugarListPat x pats _ -> do y <- mkPmId (mkListTy elem_ty) - grds <- translateListPat fam_insts y pats + grds <- desugarListPat y pats rhs_y <- dsSyntaxExpr to_list [Var x] pure $ PmLet y rhs_y : grds @@ -565,7 +566,7 @@ translatePat fam_insts x pat = case pat of , cpt_dicts = dicts } } -> do - translateConPatOut fam_insts x con arg_tys ex_tvs dicts ps + desugarConPatOut x con arg_tys ex_tvs dicts ps NPat ty (L _ olit) mb_neg _ -> do -- See Note [Literal short cut] in "GHC.HsToCore.Match.Literal" @@ -594,46 +595,44 @@ translatePat fam_insts x pat = case pat of mkPmLitGrds x lit TuplePat _tys pats boxity -> do - (vars, grdss) <- mapAndUnzipM (translateLPatV fam_insts) pats + (vars, grdss) <- mapAndUnzipM desugarLPatV pats let tuple_con = tupleDataCon boxity (length vars) pure $ vanillaConGrd x tuple_con vars : concat grdss SumPat _ty p alt arity -> do - (y, grds) <- translateLPatV fam_insts p + (y, grds) <- desugarLPatV p let sum_con = sumDataCon alt arity -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon pure $ vanillaConGrd x sum_con [y] : grds - -- -------------------------------------------------------------------------- - -- Not supposed to happen - SplicePat {} -> panic "Check.translatePat: SplicePat" + SplicePat {} -> panic "Check.desugarPat: SplicePat" --- | 'translatePat', but also select and return a new match var. -translatePatV :: FamInstEnvs -> Pat GhcTc -> DsM (Id, GrdVec) -translatePatV fam_insts pat = do +-- | 'desugarPat', but also select and return a new match var. +desugarPatV :: Pat GhcTc -> DsM (Id, GrdVec) +desugarPatV pat = do x <- selectMatchVar Many pat - grds <- translatePat fam_insts x pat + grds <- desugarPat x pat pure (x, grds) -translateLPat :: FamInstEnvs -> Id -> LPat GhcTc -> DsM GrdVec -translateLPat fam_insts x = translatePat fam_insts x . unLoc +desugarLPat :: Id -> LPat GhcTc -> DsM GrdVec +desugarLPat x = desugarPat x . unLoc --- | 'translateLPat', but also select and return a new match var. -translateLPatV :: FamInstEnvs -> LPat GhcTc -> DsM (Id, GrdVec) -translateLPatV fam_insts = translatePatV fam_insts . unLoc +-- | 'desugarLPat', but also select and return a new match var. +desugarLPatV :: LPat GhcTc -> DsM (Id, GrdVec) +desugarLPatV = desugarPatV . unLoc --- | @translateListPat _ x [p1, ..., pn]@ is basically --- @translateConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever +-- | @desugarListPat _ x [p1, ..., pn]@ is basically +-- @desugarConPatOut _ x $(mkListConPatOuts [p1, ..., pn]>@ without ever -- constructing the 'ConPatOut's. -translateListPat :: FamInstEnvs -> Id -> [LPat GhcTc] -> DsM GrdVec -translateListPat fam_insts x pats = do - vars_and_grdss <- traverse (translateLPatV fam_insts) pats +desugarListPat :: Id -> [LPat GhcTc] -> DsM GrdVec +desugarListPat x pats = do + vars_and_grdss <- traverse desugarLPatV pats mkListGrds x vars_and_grdss --- | Translate a constructor pattern -translateConPatOut :: FamInstEnvs -> Id -> ConLike -> [Type] -> [TyVar] +-- | Desugar a constructor pattern +desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar] -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdVec -translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case +desugarConPatOut x con univ_tys ex_tvs dicts = \case PrefixCon ps -> go_field_pats (zip [0..] ps) InfixCon p1 p2 -> go_field_pats (zip [0..] [p1,p2]) RecCon (HsRecFields fs _) -> go_field_pats (rec_field_ps fs) @@ -647,7 +646,7 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case where tagged_pat f = (lbl_to_index (getName (hsRecFieldId f)), hsRecFieldArg f) -- Unfortunately the label info is empty when the DataCon wasn't defined - -- with record field labels, hence we translate to field index. + -- with record field labels, hence we desugar to field index. orig_lbls = map flSelector $ conLikeFieldLabels con lbl_to_index lbl = expectJust "lbl_to_index" $ elemIndex lbl orig_lbls @@ -658,10 +657,10 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case -- the first field of @tagged_pats at . -- See Note [Field match order for RecCon] - -- Translate the mentioned field patterns. We're doing this first to get + -- Desugar the mentioned field patterns. We're doing this first to get -- the Ids for pm_con_args. let trans_pat (n, pat) = do - (var, pvec) <- translateLPatV fam_insts pat + (var, pvec) <- desugarLPatV pat pure ((n, var), pvec) (tagged_vars, arg_grdss) <- mapAndUnzipM trans_pat tagged_pats @@ -687,77 +686,81 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case -- 1. 2. 3. pure (con_grd : bang_grds ++ arg_grds) --- | Translate a the 'Match'es of a 'MatchGroup' -translateMatches :: FamInstEnvs -> [Id] -> [LMatch GhcTc (LHsExpr GhcTc)] - -> DsM GrdTree -translateMatches fam_insts vars matches = - -- It's important that we wrap a 'Sequence' even if it only wraps a singleton. - -- 'extractRhsDeltas' needs this to recover 'MatchGroup' structure. - Sequence <$> traverse (translateMatch fam_insts vars) matches - --- Translate a single match -translateMatch :: FamInstEnvs -> [Id] -> LMatch GhcTc (LHsExpr GhcTc) - -> DsM GrdTree -translateMatch fam_insts vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do - pats' <- concat <$> zipWithM (translateLPat fam_insts) vars pats - grhss' <- translateGRHSs fam_insts match_loc (sep (map ppr pats)) grhss - -- tracePm "translateMatch" (vcat [ppr pats, ppr pats', ppr grhss']) - return (foldr Guard grhss' pats') - -mkGrdTreeRhs :: Located SDoc -> GrdVec -> GrdTree -mkGrdTreeRhs sdoc = foldr Guard (Rhs sdoc) - -translateGRHSs :: FamInstEnvs -> SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM GrdTree -translateGRHSs fam_insts match_loc pp_pats grhss = - -- It's important that we wrap a 'Sequence' even if it only wraps a singleton. - -- 'extractRhsDeltas' needs this to recover 'GRHSs' structure. - Sequence <$> traverse (translateLGRHS fam_insts match_loc pp_pats) (grhssGRHSs grhss) - --- | Translate a guarded right-hand side to a single 'GrdTree' -translateLGRHS :: FamInstEnvs -> SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM GrdTree -translateLGRHS fam_insts match_loc pp_pats (L _loc (GRHS _ gs _)) = - -- _loc points to the match separator (ie =, ->) that comes after the guards.. - mkGrdTreeRhs loc_sdoc <$> concatMapM (translateGuard fam_insts . unLoc) gs - where - loc_sdoc - -- pp_pats is the space-separated pattern of the current Match this - -- GRHS belongs to, so the @A B x@ part in @A B x | 0 <- x at . - | null gs = L match_loc pp_pats - | otherwise = L grd_loc (pp_pats <+> vbar <+> interpp'SP gs) - L grd_loc _ = head gs - --- | Translate a guard statement to a 'GrdVec' -translateGuard :: FamInstEnvs -> GuardStmt GhcTc -> DsM GrdVec -translateGuard fam_insts guard = case guard of - BodyStmt _ e _ _ -> translateBoolGuard e - LetStmt _ binds -> translateLet (unLoc binds) - BindStmt _ p e -> translateBind fam_insts p e - LastStmt {} -> panic "translateGuard LastStmt" - ParStmt {} -> panic "translateGuard ParStmt" - TransStmt {} -> panic "translateGuard TransStmt" - RecStmt {} -> panic "translateGuard RecStmt" - ApplicativeStmt {} -> panic "translateGuard ApplicativeLastStmt" - --- | Translate let-bindings -translateLet :: HsLocalBinds GhcTc -> DsM GrdVec -translateLet _binds = return [] - --- | Translate a pattern guard +desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre) +-- See 'GrdPatBind' for how this simply repurposes GrdGRHS. +desugarPatBind loc var pat = + PmPatBind . flip PmGRHS (L loc (ppr pat)) <$> desugarPat var pat + +desugarEmptyCase :: Id -> DsM PmEmptyCase +desugarEmptyCase var = pure PmEmptyCase { pe_var = var } + +-- | Desugar the non-empty 'Match'es of a 'MatchGroup'. +desugarMatches :: [Id] -> NonEmpty (LMatch GhcTc (LHsExpr GhcTc)) + -> DsM (PmMatchGroup Pre) +desugarMatches vars matches = + PmMatchGroup <$> traverse (desugarMatch vars) matches + +-- Desugar a single match +desugarMatch :: [Id] -> LMatch GhcTc (LHsExpr GhcTc) -> DsM (PmMatch Pre) +desugarMatch vars (L match_loc (Match { m_pats = pats, m_grhss = grhss })) = do + pats' <- concat <$> zipWithM desugarLPat vars pats + grhss' <- desugarGRHSs match_loc (sep (map ppr pats)) grhss + -- tracePm "desugarMatch" (vcat [ppr pats, ppr pats', ppr grhss']) + return PmMatch { pm_pats = pats', pm_grhss = grhss' } + +desugarGRHSs :: SrcSpan -> SDoc -> GRHSs GhcTc (LHsExpr GhcTc) -> DsM (NonEmpty (PmGRHS Pre)) +desugarGRHSs match_loc pp_pats grhss + = traverse (desugarLGRHS match_loc pp_pats) + . expectJust "desugarGRHSs" + . NE.nonEmpty + $ grhssGRHSs grhss + +-- | Desugar a guarded right-hand side to a single 'GrdTree' +desugarLGRHS :: SrcSpan -> SDoc -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (PmGRHS Pre) +desugarLGRHS match_loc pp_pats (L _loc (GRHS _ gs _)) = do + -- _loc points to the match separator (ie =, ->) that comes after the guards. + -- Hence we have to pass in the match_loc, which we use in case that the RHS + -- is unguarded. + -- pp_pats is the space-separated pattern of the current Match this + -- GRHS belongs to, so the @A B x@ part in @A B x | 0 <- x at . + let rhs_info = case gs of + [] -> L match_loc pp_pats + (L grd_loc _):_ -> L grd_loc (pp_pats <+> vbar <+> interpp'SP gs) + grds <- concatMapM (desugarGuard . unLoc) gs + pure PmGRHS { pg_grds = grds, pg_rhs = rhs_info } + +-- | Desugar a guard statement to a 'GrdVec' +desugarGuard :: GuardStmt GhcTc -> DsM GrdVec +desugarGuard guard = case guard of + BodyStmt _ e _ _ -> desugarBoolGuard e + LetStmt _ binds -> desugarLet (unLoc binds) + BindStmt _ p e -> desugarBind p e + LastStmt {} -> panic "desugarGuard LastStmt" + ParStmt {} -> panic "desugarGuard ParStmt" + TransStmt {} -> panic "desugarGuard TransStmt" + RecStmt {} -> panic "desugarGuard RecStmt" + ApplicativeStmt {} -> panic "desugarGuard ApplicativeLastStmt" + +-- | Desugar let-bindings +desugarLet :: HsLocalBinds GhcTc -> DsM GrdVec +desugarLet _binds = return [] + +-- | Desugar a pattern guard -- @pat <- e ==> let x = e; @ -translateBind :: FamInstEnvs -> LPat GhcTc -> LHsExpr GhcTc -> DsM GrdVec -translateBind fam_insts p e = dsLExpr e >>= \case +desugarBind :: LPat GhcTc -> LHsExpr GhcTc -> DsM GrdVec +desugarBind p e = dsLExpr e >>= \case Var y | Nothing <- isDataConId_maybe y -- RHS is a variable, so that will allow us to omit the let - -> translateLPat fam_insts y p + -> desugarLPat y p rhs -> do - (x, grds) <- translateLPatV fam_insts p + (x, grds) <- desugarLPatV p pure (PmLet x rhs : grds) --- | Translate a boolean guard +-- | Desugar a boolean guard -- @e ==> let x = e; True <- x@ -translateBoolGuard :: LHsExpr GhcTc -> DsM GrdVec -translateBoolGuard e +desugarBoolGuard :: LHsExpr GhcTc -> DsM GrdVec +desugarBoolGuard e | isJust (isTrueLHsExpr e) = return [] -- The formal thing to do would be to generate (True <- True) -- but it is trivial to solve so instead we give back an empty @@ -802,7 +805,7 @@ for a pattern match appear matter. Consider a situation similar to T5117: f (0:_) = () f (0:[]) = () -The latter clause is clearly redundant. Yet if we translate the second clause as +The latter clause is clearly redundant. Yet if we desugar the second clause as [x:xs' <- xs, [] <- xs', 0 <- x] @@ -814,52 +817,11 @@ translation would have been And we have to take in the guards on list cells into @mkListGrds at . -Note [Countering exponential blowup] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Precise pattern match exhaustiveness checking is necessarily exponential in -the size of some input programs. We implement a counter-measure in the form of -the -fmax-pmcheck-models flag, limiting the number of Deltas we check against -each pattern by a constant. - -How do we do that? Consider - - f True True = () - f True True = () - -And imagine we set our limit to 1 for the sake of the example. The first clause -will be checked against the initial Delta, {}. Doing so will produce an -Uncovered set of size 2, containing the models {x/~True} and {x~True,y/~True}. -Also we find the first clause to cover the model {x~True,y~True}. - -But the Uncovered set we get out of the match is too huge! We somehow have to -ensure not to make things worse as they are already, so we continue checking -with a singleton Uncovered set of the initial Delta {}. Why is this -sound (wrt. notion of the GADTs Meet their Match paper)? Well, it basically -amounts to forgetting that we matched against the first clause. The values -represented by {} are a superset of those represented by its two refinements -{x/~True} and {x~True,y/~True}. - -This forgetfulness becomes very apparent in the example above: By continuing -with {} we don't detect the second clause as redundant, as it again covers the -same non-empty subset of {}. So we don't flag everything as redundant anymore, -but still will never flag something as redundant that isn't. - -For exhaustivity, the converse applies: We will report @f@ as non-exhaustive -and report @f _ _@ as missing, which is a superset of the actual missing -matches. But soundness means we will never fail to report a missing match. - -This mechanism is implemented in 'throttle'. - -Guards are an extreme example in this regard, with #11195 being a particularly -dreadful example: Since their RHS are often pretty much unique, we split on a -variable (the one representing the RHS) that doesn't occur anywhere else in the -program, so we don't actually get useful information out of that split! - -Note [Translate CoPats] +Note [Desugar CoPats] ~~~~~~~~~~~~~~~~~~~~~~~ -The pattern match checker did not know how to handle coerced patterns `CoPat` -efficiently, which gave rise to #11276. The original approach translated -`CoPat`s: +The pattern match checker did not know how to handle coerced patterns +`CoPat` efficiently, which gave rise to #11276. The original approach +desugared `CoPat`s: pat |> co ===> x (pat <- (x |> co)) @@ -874,108 +836,92 @@ a lot of false warnings. But we can check whether the coercion is a hole or if it is just refl, in which case we can drop it. - -%************************************************************************ -%* * - Utilities for Pattern Match Checking -%* * -%************************************************************************ -} --- ---------------------------------------------------------------------------- --- * Basic utilities - -{- -Note [Extensions to GADTs Meet Their Match] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The GADTs Meet Their Match paper presents the formalism that GHC's coverage -checker adheres to. Since the paper's publication, there have been some -additional features added to the coverage checker which are not described in -the paper. This Note serves as a reference for these new features. - -* Value abstractions are severely simplified to the point where they are just - variables. The information about the shape of a variable is encoded in - the oracle state 'Delta' instead. -* Handling of uninhabited fields like `!Void`. - See Note [Strict argument type constraints] in GHC.HsToCore.PmCheck.Oracle. -* Efficient handling of literal splitting, large enumerations and accurate - redundancy warnings for `COMPLETE` groups through the oracle. - -Note [Filtering out non-matching COMPLETE sets] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Currently, conlikes in a COMPLETE set are simply grouped by the -type constructor heading the return type. This is nice and simple, but it does -mean that there are scenarios when a COMPLETE set might be incompatible with -the type of a scrutinee. For instance, consider (from #14135): - - data Foo a = Foo1 a | Foo2 a - - pattern MyFoo2 :: Int -> Foo Int - pattern MyFoo2 i = Foo2 i - - {-# COMPLETE Foo1, MyFoo2 #-} - - f :: Foo a -> a - f (Foo1 x) = x - -`f` has an incomplete pattern-match, so when choosing which constructors to -report as unmatched in a warning, GHC must choose between the original set of -data constructors {Foo1, Foo2} and the COMPLETE set {Foo1, MyFoo2}. But observe -that GHC shouldn't even consider the COMPLETE set as a possibility: the return -type of MyFoo2, Foo Int, does not match the type of the scrutinee, Foo a, since -there's no substitution `s` such that s(Foo Int) = Foo a. - -To ensure that GHC doesn't pick this COMPLETE set, it checks each pattern -synonym constructor's return type matches the type of the scrutinee, and if one -doesn't, then we remove the whole COMPLETE set from consideration. - -One might wonder why GHC only checks /pattern synonym/ constructors, and not -/data/ constructors as well. The reason is because that the type of a -GADT constructor very well may not match the type of a scrutinee, and that's -OK. Consider this example (from #14059): - - data SBool (z :: Bool) where - SFalse :: SBool False - STrue :: SBool True - - pattern STooGoodToBeTrue :: forall (z :: Bool). () - => z ~ True - => SBool z - pattern STooGoodToBeTrue = STrue - {-# COMPLETE SFalse, STooGoodToBeTrue #-} - - wobble :: SBool z -> Bool - wobble STooGoodToBeTrue = True - -In the incomplete pattern match for `wobble`, we /do/ want to warn that SFalse -should be matched against, even though its type, SBool False, does not match -the scrutinee type, SBool z. - -SG: Another angle at this is that the implied constraints when we instantiate -universal type variables in the return type of a GADT will lead to *provided* -thetas, whereas when we instantiate the return type of a pattern synonym that -corresponds to a *required* theta. See Note [Pattern synonym result type] in -PatSyn. Note how isValidCompleteMatches will successfully filter out - - pattern Just42 :: Maybe Int - pattern Just42 = Just 42 - -But fail to filter out the equivalent - - pattern Just'42 :: (a ~ Int) => Maybe a - pattern Just'42 = Just 42 - -Which seems fine as far as tcMatchTy is concerned, but it raises a few eye -brows. --} +-- +-- * Coverage checking guard trees into annotated trees +-- -{- -%************************************************************************ -%* * - Heart of the algorithm: checkGrdTree -%* * -%************************************************************************ --} +-- | Pattern-match coverage check result +data CheckResult a + = CheckResult + { cr_ret :: !a + -- ^ A hole for redundancy info and covered sets. + , cr_uncov :: !Deltas + -- ^ The set of uncovered values falling out at the bottom. + -- (for -Wincomplete-patterns, but also important state for the algorithm) + , cr_approx :: !Precision + -- ^ A flag saying whether we ran into the 'maxPmCheckModels' limit for the + -- purpose of suggesting to crank it up in the warning message. Writer state. + } deriving Functor + +instance Outputable a => Outputable (CheckResult a) where + ppr (CheckResult c unc pc) + = text "CheckResult" <+> ppr_precision pc <+> braces (fsep + [ field "ret" c <> comma + , field "uncov" unc]) + where + ppr_precision Precise = empty + ppr_precision Approximate = text "(Approximate)" + field name value = text name <+> equals <+> ppr value + +-- | Lift 'addPmCts' over 'Deltas'. +addPmCtsDeltas :: Deltas -> PmCts -> DsM Deltas +addPmCtsDeltas deltas cts = liftDeltasM (\d -> addPmCts d cts) deltas + +-- | 'addPmCtsDeltas' for a single 'PmCt'. +addPmCtDeltas :: Deltas -> PmCt -> DsM Deltas +addPmCtDeltas deltas ct = addPmCtsDeltas deltas (unitBag ct) + +-- | Test if any of the 'Delta's is inhabited. Currently this is pure, because +-- we preserve the invariant that there are no uninhabited 'Delta's. But that +-- could change in the future, for example by implementing this function in +-- terms of @notNull <$> provideEvidence 1 ds at . +isInhabited :: Deltas -> DsM Bool +isInhabited (MkDeltas ds) = pure (not (null ds)) + +-- | Coverage checking action. Can be composed 'leftToRight' or 'topToBottom'. +newtype CheckAction a = CA { unCA :: Deltas -> DsM (CheckResult a) } + deriving Functor + +-- | Composes 'CheckAction's top-to-bottom: +-- If a value falls through the resulting action, then it must fall through the +-- first action and then through the second action. +-- If a value matches the resulting action, then it either matches the +-- first action or matches the second action. +-- Basically the semantics of the LYG branching construct. +topToBottom :: (top -> bot -> ret) + -> CheckAction top + -> CheckAction bot + -> CheckAction ret +topToBottom f (CA top) (CA bot) = CA $ \inc -> do + t <- top inc + b <- bot (cr_uncov t) + pure CheckResult { cr_ret = f (cr_ret t) (cr_ret b) + , cr_uncov = cr_uncov b + , cr_approx = cr_approx t Semi.<> cr_approx b } + + +-- | Composes 'CheckAction's left-to-right: +-- If a value falls through the resulting action, then it either falls through the +-- first action or through the second action. +-- If a value matches the resulting action, then it must match the first action +-- and then match the second action. +-- Basically the semantics of the LYG guard construct. +leftToRight :: (RedSets -> right -> ret) + -> CheckAction RedSets + -> CheckAction right + -> CheckAction ret +leftToRight f (CA left) (CA right) = CA $ \inc -> do + l <- left inc + r <- right (rs_cov (cr_ret l)) + limit <- maxPmCheckModels <$> getDynFlags + let uncov = cr_uncov l Semi.<> cr_uncov r + -- See Note [Countering exponential blowup] + let (prec', uncov') = throttle limit inc uncov + pure CheckResult { cr_ret = f (cr_ret l) (cr_ret r) + , cr_uncov = uncov' + , cr_approx = prec' Semi.<> cr_approx l Semi.<> cr_approx r } -- | @throttle limit old new@ returns @old@ if the number of 'Delta's in @new@ -- is exceeding the given @limit@ and the @old@ number of 'Delta's. @@ -993,230 +939,226 @@ conMatchForces (PmAltConLike (RealDataCon dc)) | isNewTyCon (dataConTyCon dc) = False conMatchForces _ = True --- | Makes sure that we only wrap a single 'MayDiverge' around an --- 'AnnotatedTree', purely for esthetic reasons. -mayDiverge :: AnnotatedTree -> AnnotatedTree -mayDiverge a@(MayDiverge _) = a -mayDiverge a = MayDiverge a - --- | Computes two things: --- --- * The set of uncovered values not matched by any of the clauses of the --- 'GrdTree'. Note that 'PmCon' guards are the only way in which values --- fall through from one 'Many' branch to the next. --- * An 'AnnotatedTree' that contains divergence and inaccessibility info --- for all clauses. Will be fed to 'extractRedundancyInfo' for --- presenting redundant and proper innaccessible RHSs, as well as dead --- bangs to the user. -checkGrdTree' :: GrdTree -> Deltas -> DsM CheckResult --- RHS: Check that it covers something and wrap Inaccessible if not -checkGrdTree' (Rhs sdoc) deltas = do - is_covered <- isInhabited deltas - let clauses - | is_covered = AccessibleRhs deltas sdoc - | otherwise = InaccessibleRhs sdoc - pure CheckResult - { cr_clauses = clauses - , cr_uncov = MkDeltas emptyBag - , cr_approx = Precise } --- let x = e: Refine with x ~ e -checkGrdTree' (Guard (PmLet x e) tree) deltas = do - deltas' <- addPmCtDeltas deltas (PmCoreCt x e) - checkGrdTree' tree deltas' --- Bang x: Diverge on x ~ ⊥, refine with x /~ ⊥ -checkGrdTree' (Guard (PmBang x src_bang_info) tree) deltas = do - has_diverged <- addPmCtDeltas deltas (PmBotCt x) >>= isInhabited - deltas' <- addPmCtDeltas deltas (PmNotBotCt x) - res <- checkGrdTree' tree deltas' - let clauses - | not has_diverged - , Just info <- src_bang_info - = RedundantSrcBang info (cr_clauses res) - | has_diverged - = mayDiverge (cr_clauses res) - | otherwise -- won't diverge and it wasn't a source bang - = cr_clauses res - - pure res{ cr_clauses = clauses } - --- Con: Diverge on x ~ ⊥, fall through on x /~ K and refine with x ~ K ys --- and type info -checkGrdTree' (Guard (PmCon x con tvs dicts args) tree) deltas = do - has_diverged <- - if conMatchForces con - then addPmCtDeltas deltas (PmBotCt x) >>= isInhabited - else pure False - unc_this <- addPmCtDeltas deltas (PmNotConCt x con) - deltas' <- addPmCtsDeltas deltas $ - listToBag (PmTyCt . evVarPred <$> dicts) `snocBag` PmConCt x con tvs args - -- tracePm "checkGrdTree:Con" (ppr deltas $$ ppr x $$ ppr con $$ ppr dicts $$ ppr deltas') - CheckResult tree' unc_inner prec <- checkGrdTree' tree deltas' - limit <- maxPmCheckModels <$> getDynFlags - let (prec', unc') = throttle limit deltas (unc_this Semi.<> unc_inner) - pure CheckResult - { cr_clauses = applyWhen has_diverged mayDiverge tree' - , cr_uncov = unc' - , cr_approx = prec Semi.<> prec' } --- Sequence: Thread residual uncovered sets from equation to equation -checkGrdTree' (Sequence ts) init_unc = go [] init_unc Precise ts +-- First the functions that correspond to checking LYG primitives: + +checkSequence :: (grdtree -> CheckAction anntree) -> NonEmpty grdtree -> CheckAction (NonEmpty anntree) +-- The implementation is pretty similar to +-- @traverse1 :: Apply f => (a -> f b) -> NonEmpty a -> f (NonEmpty b)@ +checkSequence act (t :| []) = (:| []) <$> act t +checkSequence act (t1 :| (t2:ts)) = + topToBottom (NE.<|) (act t1) (checkSequence act (t2:|ts)) + +checkGrd :: PmGrd -> CheckAction RedSets +checkGrd grd = CA $ \inc -> case grd of + -- let x = e: Refine with x ~ e + PmLet x e -> do + matched <- addPmCtDeltas inc (PmCoreCt x e) + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } + , cr_uncov = mempty + , cr_approx = Precise } + -- Bang x _: Diverge on x ~ ⊥, refine with x /~ ⊥ + PmBang x mb_info -> do + div <- addPmCtDeltas inc (PmBotCt x) + matched <- addPmCtDeltas inc (PmNotBotCt x) + -- See Note [Dead bang patterns] + -- mb_info = Just info <==> PmBang originates from bang pattern in source + let bangs | Just info <- mb_info = unitOL (div, info) + | otherwise = NilOL + pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } + , cr_uncov = mempty + , cr_approx = Precise } + -- Con: Diverge on x ~ ⊥, fall through on x /~ K and refine with x ~ K ys + -- and type info + PmCon x con tvs dicts args -> do + div <- if conMatchForces con + then addPmCtDeltas inc (PmBotCt x) + else pure mempty + uncov <- addPmCtDeltas inc (PmNotConCt x con) + matched <- addPmCtsDeltas inc $ + listToBag (PmTyCt . evVarPred <$> dicts) `snocBag` PmConCt x con tvs args + -- tracePm "checkGrd:Con" (ppr inc $$ ppr x $$ ppr con $$ ppr dicts $$ ppr matched) + pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } + , cr_uncov = uncov + , cr_approx = Precise } + +checkGrds :: [PmGrd] -> CheckAction RedSets +checkGrds [] = CA $ \inc -> + pure CheckResult { cr_ret = emptyRedSets { rs_cov = inc } + , cr_uncov = mempty + , cr_approx = Precise } +checkGrds (g:grds) = leftToRight merge (checkGrd g) (checkGrds grds) where - -- | Accumulates a CheckResult. Its type is more like - -- @CheckResult -> [GrdTree] -> CheckResult@, but cr_clauses is a single - -- 'AnnotatedTree', not a list thereof. Hence 3 parameters to thread the - -- fields. - go :: [AnnotatedTree] -> Deltas -> Precision -> [GrdTree] -> DsM CheckResult - -- No cases left: Fall through for all values - go ts' unc prec [] = pure CheckResult - { cr_clauses = SequenceAnn init_unc (reverse ts') - , cr_uncov = unc - , cr_approx = prec } - go ts' unc prec (t:ts) = do - CheckResult t' unc_1 prec_t <- checkGrdTree' t unc - go (t':ts') unc_1 (prec_t Semi.<> prec) ts - --- | Print diagnostic info and actually call 'checkGrdTree''. -checkGrdTree :: GrdTree -> Deltas -> DsM CheckResult -checkGrdTree guards deltas = do - tracePm "checkGrdTree {" $ vcat [ ppr guards - , ppr deltas ] - res <- checkGrdTree' guards deltas - tracePm "checkGrdTree }:" (ppr res) -- braces are easier to match by tooling - return res - --- ---------------------------------------------------------------------------- --- * Propagation of term constraints inwards when checking nested matches - -{- Note [Type and Term Equality Propagation] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -When checking a match it would be great to have all type and term information -available so we can get more precise results. For this reason we have functions -`addDictsDs' and `addTmVarCsDs' in GHC.HsToCore.Monad that store in the -environment type and term constraints (respectively) as we go deeper. - -The type constraints we propagate inwards are collected by `collectEvVarsPats' -in GHC.Hs.Pat. This handles bug #4139 ( see example - https://gitlab.haskell.org/ghc/ghc/snippets/672 ) -where this is needed. - -For term equalities we do less, we just generate equalities for HsCase. For -example we accurately give 2 redundancy warnings for the marked cases: - -f :: [a] -> Bool -f x = case x of - - [] -> case x of -- brings (x ~ []) in scope - [] -> True - (_:_) -> False -- can't happen - - (_:_) -> case x of -- brings (x ~ (_:_)) in scope - (_:_) -> True - [] -> False -- can't happen - -Functions `addScrutTmCs' is responsible for generating -these constraints. --} + merge ri_g ri_grds = -- This operation would /not/ form a Semigroup! + RedSets { rs_cov = rs_cov ri_grds + , rs_div = rs_div ri_g Semi.<> rs_div ri_grds + , rs_bangs = rs_bangs ri_g Semi.<> rs_bangs ri_grds } --- | Locally update 'dsl_deltas' with the given action, but defer evaluation --- with 'unsafeInterleaveM' in order not to do unnecessary work. -locallyExtendPmDelta :: (Deltas -> DsM Deltas) -> DsM a -> DsM a -locallyExtendPmDelta ext k = do - deltas <- getPmDeltas - deltas' <- unsafeInterleaveM $ do - deltas' <- ext deltas - inh <- isInhabited deltas' - -- If adding a constraint would lead to a contradiction, don't add it. - -- See @Note [Recovering from unsatisfiable pattern-matching constraints]@ - -- for why this is done. - if inh - then pure deltas' - else pure deltas - updPmDeltas deltas' k +checkMatchGroup :: PmMatchGroup Pre -> CheckAction (PmMatchGroup Post) +checkMatchGroup (PmMatchGroup matches) = + PmMatchGroup <$> checkSequence checkMatch matches --- | Add in-scope type constraints if the coverage checker might run and then --- run the given action. -addTyCsDs :: Origin -> Bag EvVar -> DsM a -> DsM a -addTyCsDs origin ev_vars m = do - dflags <- getDynFlags - applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmDelta (\deltas -> addPmCtsDeltas deltas (PmTyCt . evVarPred <$> ev_vars))) - m +checkMatch :: PmMatch Pre -> CheckAction (PmMatch Post) +checkMatch (PmMatch { pm_pats = grds, pm_grhss = grhss }) = + leftToRight PmMatch (checkGrds grds) (checkGRHSs grhss) --- | Add equalities for the scrutinee to the local 'DsM' environment when --- checking a case expression: --- case e of x { matches } --- When checking matches we record that (x ~ e) where x is the initial --- uncovered. All matches will have to satisfy this equality. -addScrutTmCs :: Maybe (LHsExpr GhcTc) -> [Id] -> DsM a -> DsM a -addScrutTmCs Nothing _ k = k -addScrutTmCs (Just scr) [x] k = do - scr_e <- dsLExpr scr - locallyExtendPmDelta (\deltas -> addPmCtsDeltas deltas (unitBag (PmCoreCt x scr_e))) k -addScrutTmCs _ _ _ = panic "addScrutTmCs: HsCase with more than one case binder" - -{- -%************************************************************************ -%* * - Pretty printing of exhaustiveness/redundancy check warnings -%* * -%************************************************************************ +checkGRHSs :: NonEmpty (PmGRHS Pre) -> CheckAction (NonEmpty (PmGRHS Post)) +checkGRHSs = checkSequence checkGRHS + +checkGRHS :: PmGRHS Pre -> CheckAction (PmGRHS Post) +checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = + flip PmGRHS rhs_info <$> checkGrds grds + +checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase +checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do + unc <- addPmCtDeltas inc (PmNotBotCt var) + pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } + +checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) +checkPatBind = coerce checkGRHS + +{- Note [Countering exponential blowup] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Precise pattern match exhaustiveness checking is necessarily exponential in +the size of some input programs. We implement a counter-measure in the form of +the -fmax-pmcheck-models flag, limiting the number of Deltas we check against +each pattern by a constant. + +How do we do that? Consider + + f True True = () + f True True = () + +And imagine we set our limit to 1 for the sake of the example. The first clause +will be checked against the initial Delta, {}. Doing so will produce an +Uncovered set of size 2, containing the models {x/~True} and {x~True,y/~True}. +Also we find the first clause to cover the model {x~True,y~True}. + +But the Uncovered set we get out of the match is too huge! We somehow have to +ensure not to make things worse as they are already, so we continue checking +with a singleton Uncovered set of the initial Delta {}. Why is this +sound (wrt. the notion in GADTs Meet Their Match)? Well, it basically amounts +to forgetting that we matched against the first clause. The values represented +by {} are a superset of those represented by its two refinements {x/~True} and +{x~True,y/~True}. + +This forgetfulness becomes very apparent in the example above: By continuing +with {} we don't detect the second clause as redundant, as it again covers the +same non-empty subset of {}. So we don't flag everything as redundant anymore, +but still will never flag something as redundant that isn't. + +For exhaustivity, the converse applies: We will report @f@ as non-exhaustive +and report @f _ _@ as missing, which is a superset of the actual missing +matches. But soundness means we will never fail to report a missing match. + +This mechanism is implemented in 'throttle'. + +Guards are an extreme example in this regard, with #11195 being a particularly +dreadful example: Since their RHS are often pretty much unique, we split on a +variable (the one representing the RHS) that doesn't occur anywhere else in the +program, so we don't actually get useful information out of that split! -} --- | Check whether any part of pattern match checking is enabled for this --- 'HsMatchContext' (does not matter whether it is the redundancy check or the --- exhaustiveness check). -isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext id -> Bool -isMatchContextPmChecked dflags origin kind - | isGenerated origin - = False - | otherwise - = wopt Opt_WarnOverlappingPatterns dflags || exhaustive dflags kind +-- +-- * Collecting long-distance information +-- --- | Return True when any of the pattern match warnings ('allPmCheckWarnings') --- are enabled, in which case we need to run the pattern match checker. -needToRunPmCheck :: DynFlags -> Origin -> Bool -needToRunPmCheck dflags origin - | isGenerated origin - = False - | otherwise - = notNull (filter (`wopt` dflags) allPmCheckWarnings) +ldiMatchGroup :: PmMatchGroup Post -> NonEmpty (Deltas, NonEmpty Deltas) +ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches + +ldiMatch :: PmMatch Post -> (Deltas, NonEmpty Deltas) +ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = + (rs_cov red, ldiGRHS <$> grhss) + +ldiGRHS :: PmGRHS Post -> Deltas +ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red --- | A type for organising information to be used in warnings. -data RedundancyInfo - = RedundancyInfo - { redundant_rhss :: ![SrcInfo] - , inaccessible_rhss :: ![SrcInfo] - , redundant_bangs :: ![Located SDoc] +-- +-- * Collecting redundancy information +-- + +-- | The result of redundancy checking: +-- * RHSs classified as /C/overed, /I/naccessible and /R/edundant +-- * And redundant /B/ang patterns. See Note [Dead bang patterns]. +data CIRB + = CIRB + { cirb_cov :: !(OrdList SrcInfo) -- ^ Covered clauses + , cirb_inacc :: !(OrdList SrcInfo) -- ^ Inaccessible clauses + , cirb_red :: !(OrdList SrcInfo) -- ^ Redundant clauses + , cirb_bangs :: !(OrdList SrcInfo) -- ^ Redundant bang patterns } -extractRedundancyInfo :: AnnotatedTree -> RedundancyInfo -extractRedundancyInfo tree = - RedundancyInfo { redundant_rhss = fromOL ol_red - , inaccessible_rhss = fromOL ol_inacc - , redundant_bangs = fromOL ol_bangs } - where - (_ol_acc, ol_inacc, ol_red, ol_bangs) = go tree - -- | Collects - -- 1. accessible RHSs - -- 2. proper inaccessible RHSs (so we can't delete them) - -- 3. hypothetically redundant RHSs (so not only inaccessible, but we can - -- even safely delete the equation without altering semantics) - -- 4. 'Dead' bangs from the source, collected to be warned about - -- See Note [Determining inaccessible clauses] - -- See Note [Dead bang patterns] - go :: AnnotatedTree -> (OrdList SrcInfo, OrdList SrcInfo, OrdList SrcInfo, OrdList SrcInfo) - go (AccessibleRhs _ info) = (unitOL info, nilOL, nilOL , nilOL) - go (InaccessibleRhs info) = (nilOL, nilOL, unitOL info, nilOL) -- presumably redundant - go (MayDiverge t) = case go t of - -- See Note [Determining inaccessible clauses] - (acc, inacc, red, bs) - | isNilOL acc && isNilOL inacc -> (nilOL, red, nilOL, bs) - res -> res - go (SequenceAnn _ ts) = foldMap go ts - go (RedundantSrcBang l t) = case go t of - -- See Note [Dead bang patterns] - res@(acc, inacc, _, _) - | isNilOL acc, isNilOL inacc -> res - | otherwise -> (nilOL, nilOL, nilOL, unitOL l) Semi.<> res +instance Semigroup CIRB where + CIRB a b c d <> CIRB e f g h = CIRB (a <> e) (b <> f) (c <> g) (d <> h) + where (<>) = (Semi.<>) + +instance Monoid CIRB where + mempty = CIRB mempty mempty mempty mempty + +markAllRedundant :: CIRB -> CIRB +markAllRedundant CIRB { cirb_cov = cov, cirb_inacc = inacc, cirb_red = red } = + mempty { cirb_red = cov Semi.<> inacc Semi.<> red } + +-- See Note [Determining inaccessible clauses] +ensureOneNotRedundant :: CIRB -> CIRB +ensureOneNotRedundant ci = case ci of + CIRB { cirb_cov = NilOL, cirb_inacc = NilOL, cirb_red = ConsOL r rs } + -> ci { cirb_inacc = unitOL r, cirb_red = rs } + _ -> ci + +-- | Only adds the redundant bangs to the @CIRB@ if there is at least one +-- non-redundant 'SrcInfo'. There is no point in remembering a redundant bang +-- if the whole match is redundant! +addRedundantBangs :: OrdList SrcInfo -> CIRB -> CIRB +addRedundantBangs _red_bangs cirb at CIRB { cirb_cov = NilOL, cirb_inacc = NilOL } = + cirb +addRedundantBangs red_bangs cirb = + cirb { cirb_bangs = cirb_bangs cirb Semi.<> red_bangs } + +-- | Checks the 'Deltas' in a 'RedSets' for inhabitants and returns +-- 1. Whether the Covered set was inhabited +-- 2. Whether the Diverging set was inhabited +-- 3. All source bangs whose 'Deltas' were empty, which means they are +-- redundant. +testRedSets :: RedSets -> DsM (Bool, Bool, OrdList SrcInfo) +testRedSets RedSets { rs_cov = cov, rs_div = div, rs_bangs = bangs } = do + is_covered <- isInhabited cov + may_diverge <- isInhabited div + red_bangs <- flip mapMaybeM (fromOL bangs) $ \(deltas, bang) -> do + isInhabited deltas >>= \case + True -> pure Nothing + False -> pure (Just bang) + pure (is_covered, may_diverge, toOL red_bangs) + +cirbsMatchGroup :: PmMatchGroup Post -> DsM CIRB +cirbsMatchGroup (PmMatchGroup matches) = + Semi.sconcat <$> traverse cirbsMatch matches + +cirbsMatch :: PmMatch Post -> DsM CIRB +cirbsMatch PmMatch { pm_pats = red, pm_grhss = grhss } = do + (is_covered, may_diverge, red_bangs) <- testRedSets red + cirb <- cirbsGRHSs grhss + pure $ addRedundantBangs red_bangs + -- See Note [Determining inaccessible clauses] + $ applyWhen may_diverge ensureOneNotRedundant + $ applyWhen (not is_covered) markAllRedundant + $ cirb + +cirbsGRHSs :: NonEmpty (PmGRHS Post) -> DsM CIRB +cirbsGRHSs grhss = Semi.sconcat <$> traverse cirbsGRHS grhss + +cirbsGRHS :: PmGRHS Post -> DsM CIRB +cirbsGRHS PmGRHS { pg_grds = red, pg_rhs = info } = do + (is_covered, may_diverge, red_bangs) <- testRedSets red + let cirb | is_covered = mempty { cirb_cov = unitOL info } + | may_diverge = mempty { cirb_inacc = unitOL info } + | otherwise = mempty { cirb_red = unitOL info } + pure (addRedundantBangs red_bangs cirb) + +cirbsEmptyCase :: PmEmptyCase -> DsM CIRB +cirbsEmptyCase _ = pure mempty + +cirbsPatBind :: PmPatBind Post -> DsM CIRB +cirbsPatBind = coerce cirbsGRHS {- Note [Determining inaccessible clauses] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1231,26 +1173,29 @@ arguments we can ever reach clause 2's RHS, so we say it has inaccessible RHS (as opposed to being completely redundant). We detect an inaccessible RHS simply by pretending it's redundant, until we see -that it's part of a sub-tree in the pattern match that forces some argument -(which corresponds to wrapping the 'AnnotatedTree' in 'MayDiverge'). Then we -turn all supposedly redundant RHSs into inaccessible ones. - -But as it turns out (@g@ from #17465) this is too conservative: - g () | False = () - | otherwise = () -g's first clause has an inaccessible RHS, but it's also safe to delete. So it's -redundant, really! But by just turning all redundant child clauses into -inaccessible ones, we report the first clause as inaccessible. - -Clearly, it is enough if we say that we only degrade if *not all* of the child -clauses are redundant. As long as there is at least one clause which we announce -not to be redundant, the guard prefix responsible for the 'MayDiverge' will -survive. Hence we check for that in 'extractRedundancyInfo'. -} --- | Issue all the warnings (coverage, exhaustiveness, inaccessibility) -dsPmWarn :: DynFlags -> DsMatchContext -> [Id] -> CheckResult -> DsM () -dsPmWarn dflags ctx@(DsMatchContext kind loc) vars result +-- +-- * Formatting and reporting warnings +-- + +-- | Given a function that collects 'CIRB's, this function will emit warnings +-- for a 'CheckResult'. +formatReportWarnings :: (ann -> DsM CIRB) -> DsMatchContext -> [Id] -> CheckResult ann -> DsM () +formatReportWarnings collect ctx vars cr at CheckResult { cr_ret = ann } = do + cov_info <- collect ann + dflags <- getDynFlags + reportWarnings dflags ctx vars cr{cr_ret=cov_info} + +-- | Issue all the warnings +-- (redundancy, inaccessibility, exhaustiveness, redundant bangs). +reportWarnings :: DynFlags -> DsMatchContext -> [Id] -> CheckResult CIRB -> DsM () +reportWarnings dflags ctx@(DsMatchContext kind loc) vars + CheckResult { cr_ret = CIRB { cirb_inacc = inaccessible_rhss + , cirb_red = redundant_rhss + , cirb_bangs = redundant_bangs } + , cr_uncov = uncovered + , cr_approx = precision } = when (flag_i || flag_u || flag_b) $ do unc_examples <- getNFirstUncovered vars (maxPatterns + 1) uncovered let exists_r = flag_i && notNull redundant_rhss @@ -1276,13 +1221,6 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) vars result when exists_u $ putSrcSpanDs loc $ warnDs flag_u_reason $ pprEqns vars unc_examples where - CheckResult - { cr_clauses = clauses - , cr_uncov = uncovered - , cr_approx = precision } = result - RedundancyInfo{redundant_rhss, inaccessible_rhss, redundant_bangs} - = extractRedundancyInfo clauses - flag_i = overlapping dflags kind flag_u = exhaustive dflags kind flag_b = redundant_bang dflags @@ -1323,44 +1261,30 @@ getNFirstUncovered vars n (MkDeltas deltas) = go n (bagToList deltas) back <- go (n - length front) deltas pure (front ++ back) -{- Note [Inaccessible warnings for record updates] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider (#12957) - data T a where - T1 :: { x :: Int } -> T Bool - T2 :: { x :: Int } -> T a - T3 :: T a - - f :: T Char -> T a - f r = r { x = 3 } - -The desugarer will (conservatively generate a case for T1 even though -it's impossible: - f r = case r of - T1 x -> T1 3 -- Inaccessible branch - T2 x -> T2 3 - _ -> error "Missing" - -We don't want to warn about the inaccessible branch because the programmer -didn't put it there! So we filter out the warning here. - -The same can happen for long distance term constraints instead of type -constraints (#17783): - - data T = A { x :: Int } | B { x :: Int } - f r at A{} = r { x = 3 } - f _ = B 0 - -Here, the long distance info from the FunRhs match (@r ~ A x@) will make the -clause matching on @B@ of the desugaring to @case@ redundant. It's generated -code that we don't want to warn about. --} - dots :: Int -> [a] -> SDoc dots maxPatterns qs | qs `lengthExceeds` maxPatterns = text "..." | otherwise = empty +pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc +pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun + = vcat [text txt <+> msg, + sep [ text "In" <+> ppr_match <> char ':' + , nest 4 (rest_of_msg_fun pref)]] + where + txt | singular = "Pattern match" + | otherwise = "Pattern match(es)" + + (ppr_match, pref) + = case kind of + FunRhs { mc_fun = L _ fun } + -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) + _ -> (pprMatchContext kind, \ pp -> pp) + +-- +-- * Utilities +-- + -- | All warning flags that need to run the pattern match checker. allPmCheckWarnings :: [WarningFlag] allPmCheckWarnings = @@ -1399,23 +1323,142 @@ exhaustiveWarningFlag RecUpd = Just Opt_WarnIncompletePatternsRecUpd exhaustiveWarningFlag ThPatSplice = Nothing exhaustiveWarningFlag PatSyn = Nothing exhaustiveWarningFlag ThPatQuote = Nothing -exhaustiveWarningFlag (StmtCtxt {}) = Nothing -- Don't warn about incomplete patterns - -- in list comprehensions, pattern guards - -- etc. They are often *supposed* to be - -- incomplete +-- Don't warn about incomplete patterns in list comprehensions, pattern guards +-- etc. They are often *supposed* to be incomplete +exhaustiveWarningFlag (StmtCtxt {}) = Nothing --- True <==> singular -pprContext :: Bool -> DsMatchContext -> SDoc -> ((SDoc -> SDoc) -> SDoc) -> SDoc -pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun - = vcat [text txt <+> msg, - sep [ text "In" <+> ppr_match <> char ':' - , nest 4 (rest_of_msg_fun pref)]] - where - txt | singular = "Pattern match" - | otherwise = "Pattern match(es)" +-- | Check whether any part of pattern match checking is enabled for this +-- 'HsMatchContext' (does not matter whether it is the redundancy check or the +-- exhaustiveness check). +isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext id -> Bool +isMatchContextPmChecked dflags origin kind + | isGenerated origin + = False + | otherwise + = overlapping dflags kind || exhaustive dflags kind - (ppr_match, pref) - = case kind of - FunRhs { mc_fun = L _ fun } - -> (pprMatchContext kind, \ pp -> ppr fun <+> pp) - _ -> (pprMatchContext kind, \ pp -> pp) +-- | Return True when any of the pattern match warnings ('allPmCheckWarnings') +-- are enabled, in which case we need to run the pattern match checker. +needToRunPmCheck :: DynFlags -> Origin -> Bool +needToRunPmCheck dflags origin + | isGenerated origin + = False + | otherwise + = notNull (filter (`wopt` dflags) allPmCheckWarnings) + +{- Note [Inaccessible warnings for record updates] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider (#12957) + data T a where + T1 :: { x :: Int } -> T Bool + T2 :: { x :: Int } -> T a + T3 :: T a + + f :: T Char -> T a + f r = r { x = 3 } + +The desugarer will conservatively generate a case for T1 even though +it's impossible: + f r = case r of + T1 x -> T1 3 -- Inaccessible branch + T2 x -> T2 3 + _ -> error "Missing" + +We don't want to warn about the inaccessible branch because the programmer +didn't put it there! So we filter out the warning here. + +The same can happen for long distance term constraints instead of type +constraints (#17783): + + data T = A { x :: Int } | B { x :: Int } + f r at A{} = r { x = 3 } + f _ = B 0 + +Here, the long distance info from the FunRhs match (@r ~ A x@) will make the +clause matching on @B@ of the desugaring to @case@ redundant. It's generated +code that we don't want to warn about. +-} + +-- +-- * Long-distance information +-- + +-- | Locally update 'dsl_deltas' with the given action, but defer evaluation +-- with 'unsafeInterleaveM' in order not to do unnecessary work. +locallyExtendPmDeltas :: (Deltas -> DsM Deltas) -> DsM a -> DsM a +locallyExtendPmDeltas ext k = do + deltas <- getLdiDeltas + deltas' <- unsafeInterleaveM $ ext deltas + updPmDeltas deltas' k + +-- | Add in-scope type constraints if the coverage checker might run and then +-- run the given action. +addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a +addTyCs origin ev_vars m = do + dflags <- getDynFlags + applyWhen (needToRunPmCheck dflags origin) + (locallyExtendPmDeltas (\deltas -> addPmCtsDeltas deltas (PmTyCt . evVarPred <$> ev_vars))) + m + +-- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment +-- when checking a case expression: +-- case e of x { matches } +-- When checking matches we record that (x ~ e) where x is the initial +-- uncovered. All matches will have to satisfy this equality. +addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a +addCoreScrutTmCs Nothing _ k = k +addCoreScrutTmCs (Just scr) [x] k = + flip locallyExtendPmDeltas k $ \deltas -> + addPmCtsDeltas deltas (unitBag (PmCoreCt x scr)) +addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" + +-- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. +addHsScrutTmCs :: Maybe (LHsExpr GhcTc) -> [Id] -> DsM a -> DsM a +addHsScrutTmCs Nothing _ k = k +addHsScrutTmCs (Just scr) vars k = do + scr_e <- dsLExpr scr + addCoreScrutTmCs (Just scr_e) vars k + +{- Note [Long-distance information] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider + + data Color = R | G | B + f :: Color -> Int + f R = … + f c = … (case c of + G -> True + B -> False) … + +Humans can make the "long-distance connection" between the outer pattern match +and the nested case pattern match to see that the inner pattern match is +exhaustive: @c@ can't be @R@ anymore because it was matched in the first clause +of @f at . + +To achieve similar reasoning in the coverage checker, we keep track of the set +of values that can reach a particular program point (often loosely referred to +as "Covered set") in 'GHC.HsToCore.Monad.dsl_deltas'. +We fill that set with Covered Deltas returned by the exported checking +functions, which the call sites put into place with +'GHC.HsToCore.Monad.updPmDeltas'. +Call sites also extend this set with facts from type-constraint dictionaries, +case scrutinees, etc. with the exported functions 'addTyCs', 'addCoreScrutTmCs' +and 'addHsScrutTmCs'. + +Note [Recovering from unsatisfiable pattern-matching constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Consider the following code (see #12957 and #15450): + + f :: Int ~ Bool => () + f = case True of { False -> () } + +We want to warn that the pattern-matching in `f` is non-exhaustive. But GHC +used not to do this; in fact, it would warn that the match was /redundant/! +This is because the constraint (Int ~ Bool) in `f` is unsatisfiable, and the +coverage checker deems any matches with unsatisfiable constraint sets to be +unreachable. + +We make sure to always start from an inhabited 'Deltas' by calling +'getLdiDeltas', which falls back to the trivially inhabited 'Deltas' if the +long-distance info returned by 'GHC.HsToCore.Monad.getPmDeltas' is empty. +-} ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -167,25 +167,6 @@ mkOneConFull arg_tys con = do -- * Pattern match oracle -{- Note [Recovering from unsatisfiable pattern-matching constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Consider the following code (see #12957 and #15450): - - f :: Int ~ Bool => () - f = case True of { False -> () } - -We want to warn that the pattern-matching in `f` is non-exhaustive. But GHC -used not to do this; in fact, it would warn that the match was /redundant/! -This is because the constraint (Int ~ Bool) in `f` is unsatisfiable, and the -coverage checker deems any matches with unsatisfiable constraint sets to be -unreachable. - -We decide to better than this. When beginning coverage checking, we first -check if the constraints in scope are unsatisfiable, and if so, we start -afresh with an empty set of constraints. This way, we'll get the warnings -that we expect. --} - ------------------------------------- -- * Composable satisfiability checks @@ -1266,7 +1247,7 @@ isTyConTriviallyInhabited tc = elementOfUniqSet tc triviallyInhabitedTyCons {- Note [Checking EmptyCase Expressions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Empty case expressions are strict on the scrutinee. That is, `case x of {}` -will force argument `x`. Hence, `checkMatches` is not sufficient for checking +will force argument `x`. Hence, `covCheckMatches` is not sufficient for checking empty cases, because it assumes that the match is not strict (which is true for all other cases, apart from EmptyCase). This gave rise to #10746. Instead, we do the following: ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -592,5 +592,8 @@ instance Outputable Deltas where instance Semigroup Deltas where MkDeltas l <> MkDeltas r = MkDeltas (l `unionBags` r) +instance Monoid Deltas where + mempty = MkDeltas emptyBag + liftDeltasM :: Monad m => (Delta -> m (Maybe Delta)) -> Deltas -> m Deltas liftDeltasM f (MkDeltas ds) = MkDeltas . catBagMaybes <$> (traverse f ds) ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -323,7 +323,7 @@ data DsLclEnv = DsLclEnv { dsl_meta :: DsMetaEnv, -- Template Haskell bindings dsl_loc :: RealSrcSpan, -- To put in pattern-matching error msgs - -- See Note [Note [Type and Term Equality Propagation] in "GHC.HsToCore.PmCheck" + -- See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck" -- The set of reaching values Deltas is augmented as we walk inwards, -- refined through each pattern match in turn dsl_deltas :: Deltas ===================================== compiler/GHC/Utils/Misc.hs ===================================== @@ -556,9 +556,8 @@ isSingleton :: [a] -> Bool isSingleton [_] = True isSingleton _ = False -notNull :: [a] -> Bool -notNull [] = False -notNull _ = True +notNull :: Foldable f => f a -> Bool +notNull = not . null only :: [a] -> a #if defined(DEBUG) ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -35,6 +35,9 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do hasDynamic = elem dynamic ways mconcat [ arg "-Wall" , not useColor ? builder (Ghc CompileHs) ? + -- N.B. Target.trackArgument ignores this argument from the + -- input hash to avoid superfluous recompilation, avoiding + -- #18672. arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? ===================================== hadrian/src/Target.hs ===================================== @@ -21,11 +21,12 @@ type Target = H.Target Context Builder trackArgument :: Target -> String -> Bool trackArgument target arg = case builder target of Make _ -> not $ threadArg arg - Ghc _ _ -> not $ verbosityArg arg + Ghc _ _ -> not $ verbosityArg arg || diagnosticsColorArg arg Cabal _ _ -> not $ verbosityArg arg || cabal_configure_ignore arg _ -> True where threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="] verbosityArg s = dropWhileEnd isDigit s == "-v" + diagnosticsColorArg s = "-fdiagnostics-color=" `isPrefixOf` s -- N.B. #18672 cabal_configure_ignore s = s `elem` [ "--configure-option=--quiet", "--configure-option=--disable-option-checking" ] ===================================== testsuite/tests/deSugar/should_compile/ds020.stderr ===================================== @@ -18,3 +18,11 @@ ds020.hs:20:1: warning: [-Woverlapping-patterns (in -Wdefault)] ds020.hs:23:1: warning: [-Woverlapping-patterns (in -Wdefault)] Pattern match is redundant In an equation for ‘f’: f x@(~[]) = ... + +ds020.hs:32:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: (x1 : xs1 : ys1) = ... + +ds020.hs:33:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: (~x : ~xs : ~ys) = ... ===================================== testsuite/tests/module/all.T ===================================== @@ -83,7 +83,7 @@ test('mod61', normal, compile_fail, ['']) test('mod62', normal, compile_fail, ['']) test('mod63', normal, compile_fail, ['']) test('mod64', normal, compile, ['']) -test('mod65', normal, compile, ['']) +test('mod65', normal, compile, ['-Wno-overlapping-patterns']) test('mod66', normal, compile_fail, ['']) test('mod67', normal, compile_fail, ['']) test('mod68', normal, compile_fail, ['']) ===================================== testsuite/tests/pmcheck/should_compile/T18572.hs ===================================== @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -Wincomplete-uni-patterns -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE DataKinds, KindSignatures, GADTs #-} + +module T18572 where + +True = True -- no warning + +data SBool (b :: Bool) where + STrue :: SBool True + SFalse :: SBool False + +STrue = SFalse -- "redundant", not "inaccessible" ===================================== testsuite/tests/pmcheck/should_compile/T18572.stderr ===================================== @@ -0,0 +1,16 @@ + +T18572.hs:12:1: warning: [-Winaccessible-code (in -Wdefault)] + • Couldn't match type ‘'False’ with ‘'True’ + Inaccessible code in + a pattern with constructor: STrue :: SBool 'True, + in a pattern binding + • In the pattern: STrue + In a pattern binding: STrue = SFalse + +T18572.hs:12:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: STrue = ... + +T18572.hs:12:1: warning: [-Wincomplete-uni-patterns] + Pattern match(es) are non-exhaustive + In a pattern binding: Patterns not matched: SFalse ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -102,6 +102,8 @@ test('T17234', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17248', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17340', normal, compile, + ['-Wredundant-bang-patterns']) test('T17357', expect_broken(17357), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17376', normal, compile, @@ -124,8 +126,8 @@ test('T18478', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18533', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) -test('T17340', normal, compile, - ['-Wredundant-bang-patterns']) +test('T18572', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, ===================================== testsuite/tests/rename/should_compile/T7085.stderr ===================================== @@ -1,3 +1,7 @@ T7085.hs:8:6: warning: [-Wunused-pattern-binds (in -Wextra, -Wunused-binds)] This pattern-binding binds no variables: Nothing = Just n + +T7085.hs:8:6: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In a pattern binding: Nothing = ... ===================================== testsuite/tests/simplCore/should_run/T18638.hs ===================================== @@ -0,0 +1,54 @@ +{-# LANGUAGE ExistentialQuantification, BangPatterns #-} +{-# OPTIONS_GHC -O #-} + +module Main (main) where + +import Data.IORef (newIORef, readIORef) + +data Step s = Done + | Skip !s + | Yield !Char !s + +data Stream = forall s. Stream (s -> Step s) !s !Int + +unstreamList :: Stream -> [Char] +unstreamList (Stream next s0 _) = unfold s0 + where unfold !s = case next s of + Done -> [] + Skip s' -> unfold s' + Yield x s' -> x : unfold s' +{-# INLINE [0] unstreamList #-} + +appendS :: Stream -> Stream -> Stream +appendS (Stream next s len) _ = Stream next s len +{-# INLINE [0] appendS #-} + +justifyLeftI :: Int -> Int -> Stream +justifyLeftI k u = + let + next Nothing = next (Just 0) + next (Just n) + | n < k = Yield 'a' (Just (n+1)) + | otherwise = Done + {-# INLINE next #-} + + in Stream next Nothing (max k u) +{-# INLINE [0] justifyLeftI #-} + +prettyPrintLogStats :: Int -> [String] +prettyPrintLogStats rawResults = map fromRow columns + where + columns :: [Int] + columns = map (\_ -> 0) [rawResults] + + moduleLen, lineLen :: Int + (moduleLen, lineLen) = foldr (\_ (_,_) -> (5, 2)) (0, 0) columns + + fromRow :: Int -> String + fromRow x = unstreamList (justifyLeftI moduleLen x `appendS` justifyLeftI lineLen x) + +main :: IO () +main = do + timingsRef <- newIORef 0 + timings <- readIORef timingsRef + putStrLn $ concat $ prettyPrintLogStats timings ===================================== testsuite/tests/simplCore/should_run/T18638.stdout ===================================== @@ -0,0 +1 @@ +aaaaa ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -92,3 +92,4 @@ test('T17206', exit_code(1), compile_and_run, ['']) test('T17151', [], multimod_compile_and_run, ['T17151', '']) test('T18012', normal, compile_and_run, ['']) test('T17744', normal, compile_and_run, ['']) +test('T18638', normal, compile_and_run, ['']) ===================================== testsuite/tests/unboxedsums/all.T ===================================== @@ -30,5 +30,5 @@ test('T12711', only_ways(['ghci']), ghci_script, ['T12711.script']) # extra_files([ "unboxedsums" + str(i) + ".hs" for i in range(1, 12) ])], # makefile_test, []) -test('UbxSumLevPoly', normal, compile, ['']) +test('UbxSumLevPoly', normal, compile, ['-Wno-overlapping-patterns']) test('T14051', normal, multi_compile, ['T14051.hs', [('T14051a.hs', '')], '-O2 -v0']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c34a51ae9c43abe51c34279e511d8358d039d739...04f0cae614fecbd20581326fdebdc74282305027 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c34a51ae9c43abe51c34279e511d8358d039d739...04f0cae614fecbd20581326fdebdc74282305027 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 16:25:52 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 12:25:52 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f5a5390d80aa_80b3f846796befc11443873@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: d55b96e2 by Ben Gamari at 2020-09-10T12:25:45-04:00 Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 9 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c - rts/RtsSymbols.c - rts/rts.cabal.in Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,15 +91,16 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) - (vcat cs $$ vcat fe_init_code), + (vcat cs $$ fe_init_code), foldr (appOL . toOL) nilOL bindss) where do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,24 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = moduleStableString mod + ctor_symbol = text "stginit_export_" <> ppr mod_str + list_symbol = text "stg_exports_" <> text mod_str + export_list = braces $ pprWithCommas closure_ptr hs_fns + + closure_ptr :: Id -> SDoc + closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure" mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,106 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < exports->n_entries; i++) { + StgPtr = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ ===================================== rts/RtsSymbols.c ===================================== @@ -652,7 +652,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ ===================================== rts/rts.cabal.in ===================================== @@ -140,6 +140,7 @@ library rts/EventLogWriter.h rts/FileLock.h rts/Flags.h + rts/ForeignExports.h rts/GetTime.h rts/Globals.h rts/Hpc.h @@ -412,6 +413,7 @@ library ClosureFlags.c Disassembler.c FileLock.c + ForeignExports.c Globals.c Hash.c Heap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d55b96e2ce641347a0f41fc594cf593914aca7fa -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d55b96e2ce641347a0f41fc594cf593914aca7fa You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 17:16:58 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 13:16:58 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 5 commits: Simplify Message-ID: <5f5a5f8a91b51_80b107c8d40114556ab@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: 966c190e by GHC GitLab CI at 2020-09-10T17:16:51+00:00 Simplify - - - - - 8acc7f9b by GHC GitLab CI at 2020-09-10T17:16:51+00:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #17983. - - - - - a3cf57fd by Ben Gamari at 2020-09-10T17:16:51+00:00 base: Use keepAlive# in withForeignPtr - - - - - d6a05f42 by GHC GitLab CI at 2020-09-10T17:16:51+00:00 base: Make touchForeignPtr more robust Previously touchForeignPtr would touch the ForeignPtr's associated ForeignPtrContents. However, this is a normal constructor and therefore can be eliminated by the simplifier. To ensure that the foreign pointer's contents isn't dropped we need to rather `touch#` the underlying array (which is the same thing that we key the `Weak` on when adding finalizers). - - - - - 36c95e39 by GHC GitLab CI at 2020-09-10T17:16:51+00:00 base: Make ForeignPtrContents of ForeignPtr strict As mentioned in #17290, there are strong benefits to the `ForeignPtrContents` field of `ForeignPtr` being strict. In particular, when looking at the reproducer for #17746, I noticed that the `ForeignPtrContents` was being allocated on every call to `withForeignPtr` just to be `touch#`'d'. This is a pretty large overhead for something like `withForeignPtr` that should be free. This required updating the `bytestring` submodule to avoid a bottoming `ForeignPtrContents` in `Data.ByteString.Internal` Fixes #17290. - - - - - 7 changed files: - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/CoreToStg/Prep.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Target.hs - libraries/base/Foreign/ForeignPtr/Imp.hs - libraries/base/GHC/ForeignPtr.hs - libraries/bytestring Changes: ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -68,7 +68,7 @@ import GHC.Utils.Misc import GHC.Utils.Error import GHC.Unit.Module ( moduleName, pprModuleName ) import GHC.Core.Multiplicity -import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) +import GHC.Builtin.PrimOps ( PrimOp (SeqOp, KeepAliveOp) ) {- @@ -2014,28 +2014,36 @@ rebuildCall env fun_info rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont = rebuild env (argInfoExpr fun rev_args) cont +-- | Simplifications of runRW# and keepAlive# rebuildContOpCall :: SimplEnv -> ArgInfo -> SimplCont -> Maybe (SimplM (SimplFloats, OutExpr)) ----------- The runRW# rule. Do this after absorbing all arguments ------ +rebuildContOpCall _env _arg_info cont + | contIsStop cont -- Don't fiddle around if the continuation is boring + = Nothing + -- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep. -- --- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o --- K[ runRW# rr ty body ] --> runRW rr' ty' (\s. K[ body s ]) +-- N.B. runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). +-- (State# RealWorld -> o) -> o +-- +-- K[ runRW# rr ty body ] +-- ~> +-- runRW rr' ty' (\s. K[ body s ]) rebuildContOpCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) (ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_cont = cont, sc_hole_ty = fun_ty }) | fun_id `hasKey` runRWKey - , not (contIsStop cont) -- Don't fiddle around if the continuation is boring , [ TyArg {}, TyArg {} ] <- rev_args = Just $ do { s <- newId (fsLit "s") Many realWorldStatePrimTy ; let (m,_,_) = splitFunTy fun_ty env' = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s] ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s , sc_env = env', sc_cont = cont - , sc_hole_ty = mkVisFunTy m realWorldStatePrimTy ty' } + , sc_hole_ty = k'_ty } -- cont' applies to s, then K ; body' <- simplExprC env' arg cont' ; let arg' = Lam s body' @@ -2043,6 +2051,48 @@ rebuildContOpCall call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg ty', arg'] ; return (emptyFloats env, call') } +-- See Note [Simplification of keepAlive#] in GHC.CoreToStg.Prep. +-- +-- K[keepAlive# @a_rep @a @r_rep @r x s k] +-- ~> +-- keepAlive# @a_rep @a @r_rep @r x s K[k] +rebuildContOpCall + env + (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) + (ApplyToVal { sc_arg = k, sc_env = k_se + , sc_cont = cont, sc_hole_ty = fun_ty }) + | Just KeepAliveOp <- isPrimOpId_maybe fun_id + , [ ValArg {as_arg=s0} + , ValArg {as_arg=x} + , TyArg {} -- res_ty + , TyArg {} -- res_rep + , TyArg {as_arg_ty=arg_ty} + , TyArg {as_arg_ty=arg_rep} + ] <- rev_args + = Just $ + do { s <- newId (fsLit "s") One realWorldStatePrimTy + ; let (m,_,_) = splitFunTy fun_ty + k_env = (k_se `setInScopeFromE` env) `addNewInScopeIds` [s] + ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' + k_cont = ApplyToVal { sc_dup = Simplified, sc_arg = Var s + , sc_env = k_env, sc_cont = cont + , sc_hole_ty = k'_ty } + ; k' <- simplExprC k_env k k_cont + ; let env' = zapSubstEnv env + ; s0' <- simplExpr env' s0 + ; x' <- simplExpr env' x + ; arg_rep' <- simplType env' arg_rep + ; arg_ty' <- simplType env' arg_ty + ; let call' = mkApps (Var fun_id) + [ mkTyArg arg_rep', mkTyArg arg_ty' + , mkTyArg (getRuntimeRep ty'), mkTyArg ty' + , x' + , s0' + , Lam s k' + ] + ; return (emptyFloats env, call') } + rebuildContOpCall _ _ _ = Nothing {- Note [Trying rewrite rules] ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1096,10 +1096,26 @@ Breaking our desired invariant. Ultimately we decided to simply accept that the continuation may not be a manifest lambda. +Note [Simplification of keepAlive#] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The keepAlive# primop benefits from a similar optimisation to that described in +Note [Simplification of runRW#] above. Specifically, we transform: + + K[keepAlive# @a_rep @a @r_rep @r x s k] + ~> + keepAlive# @a_rep @a @r_rep @r x s K[k] + +The reasons are similar to those described in Note [Simplification of runRW#]. + +-} + + -- --------------------------------------------------------------------------- -- CpeArg: produces a result satisfying CpeArg -- --------------------------------------------------------------------------- +{- Note [ANF-ising literal string arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -35,6 +35,9 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do hasDynamic = elem dynamic ways mconcat [ arg "-Wall" , not useColor ? builder (Ghc CompileHs) ? + -- N.B. Target.trackArgument ignores this argument from the + -- input hash to avoid superfluous recompilation, avoiding + -- #18672. arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? ===================================== hadrian/src/Target.hs ===================================== @@ -21,11 +21,12 @@ type Target = H.Target Context Builder trackArgument :: Target -> String -> Bool trackArgument target arg = case builder target of Make _ -> not $ threadArg arg - Ghc _ _ -> not $ verbosityArg arg + Ghc _ _ -> not $ verbosityArg arg || diagnosticsColorArg arg Cabal _ _ -> not $ verbosityArg arg || cabal_configure_ignore arg _ -> True where threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="] verbosityArg s = dropWhileEnd isDigit s == "-v" + diagnosticsColorArg s = "-fdiagnostics-color=" `isPrefixOf` s -- N.B. #18672 cabal_configure_ignore s = s `elem` [ "--configure-option=--quiet", "--configure-option=--disable-option-checking" ] ===================================== libraries/base/Foreign/ForeignPtr/Imp.hs ===================================== @@ -66,31 +66,6 @@ newForeignPtr finalizer p addForeignPtrFinalizer finalizer fObj return fObj -withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b --- ^This is a way to look at the pointer living inside a --- foreign object. This function takes a function which is --- applied to that pointer. The resulting 'IO' action is then --- executed. The foreign object is kept alive at least during --- the whole action, even if it is not used directly --- inside. Note that it is not safe to return the pointer from --- the action and use it after the action completes. All uses --- of the pointer should be inside the --- 'withForeignPtr' bracket. The reason for --- this unsafeness is the same as for --- 'unsafeForeignPtrToPtr' below: the finalizer --- may run earlier than expected, because the compiler can only --- track usage of the 'ForeignPtr' object, not --- a 'Ptr' object made from it. --- --- This function is normally used for marshalling data to --- or from the object pointed to by the --- 'ForeignPtr', using the operations from the --- 'Storable' class. -withForeignPtr fo io - = do r <- io (unsafeForeignPtrToPtr fo) - touchForeignPtr fo - return r - -- | This variant of 'newForeignPtr' adds a finalizer that expects an -- environment in addition to the finalized pointer. The environment -- that will be passed to the finalizer is fixed by the second argument to ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -3,6 +3,8 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE Unsafe #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE KindSignatures #-} {-# OPTIONS_HADDOCK not-home #-} @@ -46,6 +48,7 @@ module GHC.ForeignPtr castForeignPtr, plusForeignPtr, -- * Finalization + withForeignPtr, touchForeignPtr, finalizeForeignPtr -- * Commentary @@ -55,6 +58,7 @@ module GHC.ForeignPtr import Foreign.Storable import Data.Foldable ( sequence_ ) +import GHC.Types import GHC.Show import GHC.Base import GHC.IORef @@ -79,7 +83,7 @@ import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) -- type argument of 'ForeignPtr' should normally be an instance of -- class 'Storable'. -- -data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents +data ForeignPtr a = ForeignPtr Addr# !ForeignPtrContents -- The Addr# in the ForeignPtr object is intentionally stored -- separately from the finalizer. The primary aim of the -- representation is to make withForeignPtr efficient; in fact, @@ -124,7 +128,7 @@ data ForeignPtrContents -- ^ The pointer refers to unmanaged memory that should not be freed when -- the 'ForeignPtr' becomes unreachable. Functions that add finalizers -- to a 'ForeignPtr' throw exceptions when the 'ForeignPtr' is backed by - -- 'PlainPtr'Most commonly, this is used with @Addr#@ literals. + -- 'PlainPtr'. Most commonly, this is used with @Addr#@ literals. -- See Note [Why FinalPtr]. -- -- @since 4.15 @@ -162,6 +166,7 @@ data ForeignPtrContents -- The invariants that apply to 'MallocPtr' apply to 'PlainPtr' as well. -- Note [Why FinalPtr] +-- ~~~~~~~~~~~~~~~~~~~ -- -- FinalPtr exists as an optimization for foreign pointers created -- from Addr# literals. Most commonly, this happens in the bytestring @@ -428,7 +433,7 @@ addForeignPtrConcFinalizer_ f@(MallocPtr fo r) finalizer = do else return () where finalizer' :: State# RealWorld -> (# State# RealWorld, () #) - finalizer' = unIO (foreignPtrFinalizer r >> touch f) + finalizer' = unIO (foreignPtrFinalizer r >> touchForeignPtrContents f) addForeignPtrConcFinalizer_ _ _ = errorWithoutStackTrace "GHC.ForeignPtr: attempt to add a finalizer to plain pointer or a final pointer" @@ -503,6 +508,36 @@ newForeignPtr_ (Ptr obj) = do r <- newIORef NoFinalizers return (ForeignPtr obj (PlainForeignPtr r)) +withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +-- ^This is a way to look at the pointer living inside a +-- foreign object. This function takes a function which is +-- applied to that pointer. The resulting 'IO' action is then +-- executed. The foreign object is kept alive at least during +-- the whole action, even if it is not used directly +-- inside. Note that it is not safe to return the pointer from +-- the action and use it after the action completes. All uses +-- of the pointer should be inside the +-- 'withForeignPtr' bracket. The reason for +-- this unsafeness is the same as for +-- 'unsafeForeignPtrToPtr' below: the finalizer +-- may run earlier than expected, because the compiler can only +-- track usage of the 'ForeignPtr' object, not +-- a 'Ptr' object made from it. +-- +-- This function is normally used for marshalling data to +-- or from the object pointed to by the +-- 'ForeignPtr', using the operations from the +-- 'Storable' class. +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> + case f (unsafeForeignPtrToPtr fo) of + IO action# -> + case r of + PlainForeignPtr ref -> keepAlive# ref s action# + FinalPtr -> action# s + MallocPtr mba _ -> keepAlive# mba s action# + PlainPtr mba -> keepAlive# mba s action# + + touchForeignPtr :: ForeignPtr a -> IO () -- ^This function ensures that the foreign object in -- question is alive at the given place in the sequence of IO @@ -528,10 +563,19 @@ touchForeignPtr :: ForeignPtr a -> IO () -- result in artificial deadlock. Another alternative is to use -- explicit reference counting. -- -touchForeignPtr (ForeignPtr _ r) = touch r +touchForeignPtr (ForeignPtr _ r) = touchForeignPtrContents r + +touchForeignPtrContents :: ForeignPtrContents -> IO () +touchForeignPtrContents (PlainForeignPtr ref) = touchLifted ref +touchForeignPtrContents FinalPtr = return () +touchForeignPtrContents (MallocPtr mba _) = touchUnlifted mba +touchForeignPtrContents (PlainPtr mba) = touchUnlifted mba + +touchLifted :: a -> IO () +touchLifted r = IO $ \s -> case touch# r s of s' -> (# s', () #) -touch :: ForeignPtrContents -> IO () -touch r = IO $ \s -> case touch# r s of s' -> (# s', () #) +touchUnlifted :: forall (a :: TYPE 'UnliftedRep). a -> IO () +touchUnlifted r = IO $ \s -> case touch# r s of s' -> (# s', () #) unsafeForeignPtrToPtr :: ForeignPtr a -> Ptr a -- ^This function extracts the pointer component of a foreign ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit e6cb01e2ec0bfdd19298418c85f220925a9fa307 +Subproject commit cff1ad3422ed463cf92ea996b276da9156200bbf View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03b1daef7b206c7ad66b8a417381a90b0070d28e...36c95e394bd58147070966409d4ba926799db094 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/03b1daef7b206c7ad66b8a417381a90b0070d28e...36c95e394bd58147070966409d4ba926799db094 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 18:51:36 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 14:51:36 -0400 Subject: [Git][ghc/ghc][wip/bump-win32] Bump version to 9.0 Message-ID: <5f5a75b82b81a_80b3f8468d347e01145991a@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/bump-win32 at Glasgow Haskell Compiler / GHC Commits: 4fa2b173 by Ben Gamari at 2020-09-10T14:51:27-04:00 Bump version to 9.0 (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 3 changed files: - configure.ac - libraries/haskeline - utils/haddock Changes: ===================================== 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.11.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.0.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} ===================================== libraries/haskeline ===================================== @@ -1 +1 @@ -Subproject commit 1b4f19ef56adc86a860884363d3dcb19bc09d01b +Subproject commit 0f8d5b73a0cbabea6d1b88a5fc2f06ea219a7bea ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 +Subproject commit b95f6f29899a8a58223732a6633a47a35b8f1d6a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fa2b173f05b0f5e6bf2702813f3d767a0ebc0a8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4fa2b173f05b0f5e6bf2702813f3d767a0ebc0a8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 19:55:56 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 15:55:56 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 4 commits: Simplify Message-ID: <5f5a84cc356f5_80b3f849c35ee8011463260@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: c8a66f71 by GHC GitLab CI at 2020-09-10T19:55:40+00:00 Simplify - - - - - 8b633c38 by GHC GitLab CI at 2020-09-10T19:55:40+00:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #17983. - - - - - 8ce97697 by Ben Gamari at 2020-09-10T19:55:40+00:00 base: Use keepAlive# in withForeignPtr - - - - - be85911a by GHC GitLab CI at 2020-09-10T19:55:40+00:00 base: Make ForeignPtrContents of ForeignPtr strict As mentioned in #17290, there are strong benefits to the `ForeignPtrContents` field of `ForeignPtr` being strict. In particular, when looking at the reproducer for #17746, I noticed that the `ForeignPtrContents` was being allocated on every call to `withForeignPtr` just to be `touch#`'d'. This is a pretty large overhead for something like `withForeignPtr` that should be free. This required updating the `bytestring` submodule to avoid a bottoming `ForeignPtrContents` in `Data.ByteString.Internal` Fixes #17290. - - - - - 7 changed files: - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/CoreToStg/Prep.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Target.hs - libraries/base/Foreign/ForeignPtr/Imp.hs - libraries/base/GHC/ForeignPtr.hs - libraries/bytestring Changes: ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -68,7 +68,7 @@ import GHC.Utils.Misc import GHC.Utils.Error import GHC.Unit.Module ( moduleName, pprModuleName ) import GHC.Core.Multiplicity -import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) +import GHC.Builtin.PrimOps ( PrimOp (SeqOp, KeepAliveOp) ) {- @@ -2014,28 +2014,36 @@ rebuildCall env fun_info rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont = rebuild env (argInfoExpr fun rev_args) cont +-- | Simplifications of runRW# and keepAlive# rebuildContOpCall :: SimplEnv -> ArgInfo -> SimplCont -> Maybe (SimplM (SimplFloats, OutExpr)) ----------- The runRW# rule. Do this after absorbing all arguments ------ +rebuildContOpCall _env _arg_info cont + | contIsStop cont -- Don't fiddle around if the continuation is boring + = Nothing + -- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep. -- --- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o --- K[ runRW# rr ty body ] --> runRW rr' ty' (\s. K[ body s ]) +-- N.B. runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). +-- (State# RealWorld -> o) -> o +-- +-- K[ runRW# rr ty body ] +-- ~> +-- runRW rr' ty' (\s. K[ body s ]) rebuildContOpCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) (ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_cont = cont, sc_hole_ty = fun_ty }) | fun_id `hasKey` runRWKey - , not (contIsStop cont) -- Don't fiddle around if the continuation is boring , [ TyArg {}, TyArg {} ] <- rev_args = Just $ - do { s <- newId (fsLit "s") Many realWorldStatePrimTy + do { s <- newId (fsLit "s") One realWorldStatePrimTy ; let (m,_,_) = splitFunTy fun_ty env' = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s] ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s , sc_env = env', sc_cont = cont - , sc_hole_ty = mkVisFunTy m realWorldStatePrimTy ty' } + , sc_hole_ty = k'_ty } -- cont' applies to s, then K ; body' <- simplExprC env' arg cont' ; let arg' = Lam s body' @@ -2043,6 +2051,48 @@ rebuildContOpCall call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg ty', arg'] ; return (emptyFloats env, call') } +-- See Note [Simplification of keepAlive#] in GHC.CoreToStg.Prep. +-- +-- K[keepAlive# @a_rep @a @r_rep @r x s k] +-- ~> +-- keepAlive# @a_rep @a @r_rep @r x s K[k] +rebuildContOpCall + env + (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) + (ApplyToVal { sc_arg = k, sc_env = k_se + , sc_cont = cont, sc_hole_ty = fun_ty }) + | Just KeepAliveOp <- isPrimOpId_maybe fun_id + , [ ValArg {as_arg=s0} + , ValArg {as_arg=x} + , TyArg {} -- res_ty + , TyArg {} -- res_rep + , TyArg {as_arg_ty=arg_ty} + , TyArg {as_arg_ty=arg_rep} + ] <- rev_args + = Just $ + do { s <- newId (fsLit "s") One realWorldStatePrimTy + ; let (m,_,_) = splitFunTy fun_ty + k_env = (k_se `setInScopeFromE` env) `addNewInScopeIds` [s] + ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' + k_cont = ApplyToVal { sc_dup = Simplified, sc_arg = Var s + , sc_env = k_env, sc_cont = cont + , sc_hole_ty = k'_ty } + ; k' <- simplExprC k_env k k_cont + ; let env' = zapSubstEnv env + ; s0' <- simplExpr env' s0 + ; x' <- simplExpr env' x + ; arg_rep' <- simplType env' arg_rep + ; arg_ty' <- simplType env' arg_ty + ; let call' = mkApps (Var fun_id) + [ mkTyArg arg_rep', mkTyArg arg_ty' + , mkTyArg (getRuntimeRep ty'), mkTyArg ty' + , x' + , s0' + , Lam s k' + ] + ; return (emptyFloats env, call') } + rebuildContOpCall _ _ _ = Nothing {- Note [Trying rewrite rules] ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1096,10 +1096,26 @@ Breaking our desired invariant. Ultimately we decided to simply accept that the continuation may not be a manifest lambda. +Note [Simplification of keepAlive#] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The keepAlive# primop benefits from a similar optimisation to that described in +Note [Simplification of runRW#] above. Specifically, we transform: + + K[keepAlive# @a_rep @a @r_rep @r x s k] + ~> + keepAlive# @a_rep @a @r_rep @r x s K[k] + +The reasons are similar to those described in Note [Simplification of runRW#]. + +-} + + -- --------------------------------------------------------------------------- -- CpeArg: produces a result satisfying CpeArg -- --------------------------------------------------------------------------- +{- Note [ANF-ising literal string arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -35,6 +35,9 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do hasDynamic = elem dynamic ways mconcat [ arg "-Wall" , not useColor ? builder (Ghc CompileHs) ? + -- N.B. Target.trackArgument ignores this argument from the + -- input hash to avoid superfluous recompilation, avoiding + -- #18672. arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? ===================================== hadrian/src/Target.hs ===================================== @@ -21,11 +21,12 @@ type Target = H.Target Context Builder trackArgument :: Target -> String -> Bool trackArgument target arg = case builder target of Make _ -> not $ threadArg arg - Ghc _ _ -> not $ verbosityArg arg + Ghc _ _ -> not $ verbosityArg arg || diagnosticsColorArg arg Cabal _ _ -> not $ verbosityArg arg || cabal_configure_ignore arg _ -> True where threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="] verbosityArg s = dropWhileEnd isDigit s == "-v" + diagnosticsColorArg s = "-fdiagnostics-color=" `isPrefixOf` s -- N.B. #18672 cabal_configure_ignore s = s `elem` [ "--configure-option=--quiet", "--configure-option=--disable-option-checking" ] ===================================== libraries/base/Foreign/ForeignPtr/Imp.hs ===================================== @@ -66,31 +66,6 @@ newForeignPtr finalizer p addForeignPtrFinalizer finalizer fObj return fObj -withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b --- ^This is a way to look at the pointer living inside a --- foreign object. This function takes a function which is --- applied to that pointer. The resulting 'IO' action is then --- executed. The foreign object is kept alive at least during --- the whole action, even if it is not used directly --- inside. Note that it is not safe to return the pointer from --- the action and use it after the action completes. All uses --- of the pointer should be inside the --- 'withForeignPtr' bracket. The reason for --- this unsafeness is the same as for --- 'unsafeForeignPtrToPtr' below: the finalizer --- may run earlier than expected, because the compiler can only --- track usage of the 'ForeignPtr' object, not --- a 'Ptr' object made from it. --- --- This function is normally used for marshalling data to --- or from the object pointed to by the --- 'ForeignPtr', using the operations from the --- 'Storable' class. -withForeignPtr fo io - = do r <- io (unsafeForeignPtrToPtr fo) - touchForeignPtr fo - return r - -- | This variant of 'newForeignPtr' adds a finalizer that expects an -- environment in addition to the finalized pointer. The environment -- that will be passed to the finalizer is fixed by the second argument to ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -46,6 +46,7 @@ module GHC.ForeignPtr castForeignPtr, plusForeignPtr, -- * Finalization + withForeignPtr, touchForeignPtr, finalizeForeignPtr -- * Commentary @@ -79,7 +80,7 @@ import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) -- type argument of 'ForeignPtr' should normally be an instance of -- class 'Storable'. -- -data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents +data ForeignPtr a = ForeignPtr Addr# !ForeignPtrContents -- The Addr# in the ForeignPtr object is intentionally stored -- separately from the finalizer. The primary aim of the -- representation is to make withForeignPtr efficient; in fact, @@ -503,6 +504,31 @@ newForeignPtr_ (Ptr obj) = do r <- newIORef NoFinalizers return (ForeignPtr obj (PlainForeignPtr r)) +withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +-- ^This is a way to look at the pointer living inside a +-- foreign object. This function takes a function which is +-- applied to that pointer. The resulting 'IO' action is then +-- executed. The foreign object is kept alive at least during +-- the whole action, even if it is not used directly +-- inside. Note that it is not safe to return the pointer from +-- the action and use it after the action completes. All uses +-- of the pointer should be inside the +-- 'withForeignPtr' bracket. The reason for +-- this unsafeness is the same as for +-- 'unsafeForeignPtrToPtr' below: the finalizer +-- may run earlier than expected, because the compiler can only +-- track usage of the 'ForeignPtr' object, not +-- a 'Ptr' object made from it. +-- +-- This function is normally used for marshalling data to +-- or from the object pointed to by the +-- 'ForeignPtr', using the operations from the +-- 'Storable' class. +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> + case f (unsafeForeignPtrToPtr fo) of + IO action# -> keepAlive# r s action# + + touchForeignPtr :: ForeignPtr a -> IO () -- ^This function ensures that the foreign object in -- question is alive at the given place in the sequence of IO ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit e6cb01e2ec0bfdd19298418c85f220925a9fa307 +Subproject commit cff1ad3422ed463cf92ea996b276da9156200bbf View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36c95e394bd58147070966409d4ba926799db094...be85911a5946ad341e1cca1684655619bec15339 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/36c95e394bd58147070966409d4ba926799db094...be85911a5946ad341e1cca1684655619bec15339 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 21:38:41 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 10 Sep 2020 17:38:41 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: Add long-distance info for pattern bindings (#18572) Message-ID: <5f5a9ce136b1e_80b3f8434f8e5b0114803de@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 6abe4a1c by Sebastian Graf at 2020-09-10T17:02:00+02:00 .gitignore *.hiedb files - - - - - 3777be14 by Sebastian Graf at 2020-09-10T17:03:12+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 1085826b by Ben Gamari at 2020-09-10T17:38:34-04:00 Bump version to 9.0 (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 12 changed files: - .gitignore - compiler/GHC/Core/DataCon.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Match.hs-boot - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dfb03b7cba48ea8b829c2d2678048e89e45ee88a...1085826b9b5ef2404fc070dff9967d2d0f375b11 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dfb03b7cba48ea8b829c2d2678048e89e45ee88a...1085826b9b5ef2404fc070dff9967d2d0f375b11 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 22:30:10 2020 From: gitlab at gitlab.haskell.org (Alan Zimmerman) Date: Thu, 10 Sep 2020 18:30:10 -0400 Subject: [Git][ghc/ghc][wip/az/exactprint] Fix up after rebasing to bring in XRec Message-ID: <5f5aa8f26fd2a_80b3f8486fbbf041148230@gitlab.haskell.org.mail> Alan Zimmerman pushed to branch wip/az/exactprint at Glasgow Haskell Compiler / GHC Commits: b2b9f739 by Alan Zimmerman at 2020-09-10T23:29:45+01:00 Fix up after rebasing to bring in XRec Main thing is to make type instance XRec (GhcPass p) a = GenLocated (Anno a) a type family Anno a = b But this has massive implications. - - - - - 25 changed files: - compiler/GHC.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Hs.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Dump.hs - compiler/GHC/Hs/Expr.hs - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/Extension.hs - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Instances.hs - compiler/GHC/Hs/Pat.hs - compiler/GHC/Hs/Pat.hs-boot - compiler/GHC/Hs/Type.hs - compiler/GHC/Hs/Utils.hs - compiler/GHC/HsToCore/Arrows.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Foreign/Decl.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/ListComp.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Utils.hs - compiler/GHC/Iface/Ext/Ast.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2b9f73904246d32f8dfefde3b53a700a2950f1f -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b2b9f73904246d32f8dfefde3b53a700a2950f1f You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Thu Sep 10 23:56:57 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 19:56:57 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f5abd4990fbc_80b3f848699424811490954@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: e6c72bb0 by Ben Gamari at 2020-09-10T19:56:51-04:00 Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 9 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c - rts/RtsSymbols.c - rts/rts.cabal.in Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,15 +91,16 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) - (vcat cs $$ vcat fe_init_code), + (vcat cs $$ fe_init_code), foldr (appOL . toOL) nilOL bindss) where do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,24 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = moduleStableString mod + ctor_symbol = text "stginit_export_" <> ppr mod_str + list_symbol = text "stg_exports_" <> text mod_str + export_list = braces $ pprWithCommas closure_ptr hs_fns + + closure_ptr :: Id -> SDoc + closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure" mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,108 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "RtsUtils.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < pending->n_entries; i++) { + StgPtr p = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + ForeignExportsStablePtr *fe_sptr = (ForeignExportsStablePtr *) + stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ ===================================== rts/RtsSymbols.c ===================================== @@ -652,7 +652,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ ===================================== rts/rts.cabal.in ===================================== @@ -140,6 +140,7 @@ library rts/EventLogWriter.h rts/FileLock.h rts/Flags.h + rts/ForeignExports.h rts/GetTime.h rts/Globals.h rts/Hpc.h @@ -412,6 +413,7 @@ library ClosureFlags.c Disassembler.c FileLock.c + ForeignExports.c Globals.c Hash.c Heap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6c72bb0206d5f6c86e95cff4d42572d8eacb310 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e6c72bb0206d5f6c86e95cff4d42572d8eacb310 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 01:33:18 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Thu, 10 Sep 2020 21:33:18 -0400 Subject: [Git][ghc/ghc][wip/initializers] Refactor foreign export tracking Message-ID: <5f5ad3debc4c2_80b3f842993d39c11493312@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: d2d0faba by Ben Gamari at 2020-09-10T21:33:11-04:00 Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - 9 changed files: - compiler/GHC/HsToCore/Foreign/Decl.hs - includes/Rts.h - + includes/rts/ForeignExports.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/RtsStartup.c - rts/RtsSymbols.c - rts/rts.cabal.in Changes: ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,15 +91,16 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) - (vcat cs $$ vcat fe_init_code), + (vcat cs $$ fe_init_code), foldr (appOL . toOL) nilOL bindss) where do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,24 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = moduleStableString mod + ctor_symbol = text "stginit_export_" <> ppr mod_str + list_symbol = text "stg_exports_" <> text mod_str + export_list = braces $ pprWithCommas closure_ptr hs_fns + + closure_ptr :: Id -> SDoc + closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure" mkHObj :: Type -> SDoc ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,26 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +struct ForeignExportsList { + struct ForeignExportsList *next; + struct _ObjectCode *oc; + int n_entries; + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,108 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "RtsUtils.h" +#include "ForeignExports.h" + +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` it loads for the sake of unloading. + * For this reason, the linker informs us when it is loading an object by calling + * `foreignExportsLoadingObject` and `foreignExportsFinishedLoadingObject`. We + * take note of the `ObjectCode*` we are loading in `loading_obj` such that we + * can associate the `StablePtr` with the `ObjectCode` in + * `processForeignExports`. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +void processForeignExports() +{ + while (pending) { + for (int i=0; i < pending->n_entries; i++) { + StgPtr p = pending->exports[i]; + StgStablePtr *sptr = getStablePtr(p); + + if (loading_obj != NULL) { + ForeignExportStablePtr *fe_sptr = (ForeignExportStablePtr *) + stgMallocBytes(sizeof(ForeignExportStablePtr), + "foreignExportStablePtr"); + fe_sptr->stable_ptr = sptr; + fe_sptr->next = loading_obj->stable_ptrs; + pending->oc->stable_ptrs = fe_sptr; + } + } + + pending = pending->next; + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1793,7 +1763,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1774,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ ===================================== rts/RtsSymbols.c ===================================== @@ -652,7 +652,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ ===================================== rts/rts.cabal.in ===================================== @@ -140,6 +140,7 @@ library rts/EventLogWriter.h rts/FileLock.h rts/Flags.h + rts/ForeignExports.h rts/GetTime.h rts/Globals.h rts/Hpc.h @@ -412,6 +413,7 @@ library ClosureFlags.c Disassembler.c FileLock.c + ForeignExports.c Globals.c Hash.c Heap.c View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2d0faba923909d2dc18342c310807e571ff5bf3 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d2d0faba923909d2dc18342c310807e571ff5bf3 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 02:23:49 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Thu, 10 Sep 2020 22:23:49 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/aarch64-TSAN Message-ID: <5f5adfb532ff6_80b3f8428d2e4c01149516a@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/aarch64-TSAN at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/aarch64-TSAN You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 03:08:58 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Thu, 10 Sep 2020 23:08:58 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Bump version to 9.0 Message-ID: <5f5aea4aa4d05_80b789cfe01151027f@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 40767109 by Ben Gamari at 2020-09-10T23:08:48-04:00 Bump version to 9.0 (cherry picked from commit f218cfc92f7b1a1e01190851972bb9a0e0f3c682) - - - - - 7dcbaf22 by David Himmelstrup at 2020-09-10T23:08:49-04:00 Define TICKY_TICKY when compiling cmm RTS files. - - - - - 552defed by David Himmelstrup at 2020-09-10T23:08:49-04:00 Fix typos in TICKY_TICKY symbol names. - - - - - d241dc01 by David Himmelstrup at 2020-09-10T23:08:49-04:00 Enable TICKY_TICKY for debug builds when building with makefiles. - - - - - 7 changed files: - configure.ac - hadrian/src/Settings/Packages.hs - includes/Cmm.h - includes/stg/Ticky.h - mk/ways.mk - rts/Ticky.c - utils/haddock Changes: ===================================== 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.11.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.0.0], [glasgow-haskell-bugs at haskell.org], [ghc-AC_PACKAGE_VERSION]) # Set this to YES for a released version, otherwise NO : ${RELEASE=NO} ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -279,7 +279,8 @@ rtsPackageArgs = package rts ? do , arg $ "-DFS_NAMESPACE=rts" , arg $ "-DCOMPILING_RTS" , notM targetSupportsSMP ? arg "-DNOSMP" - , way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY" + , way `elem` [debug, debugDynamic] ? pure [ "-DTICKY_TICKY" + , "-optc-DTICKY_TICKY"] , Profiling `wayUnit` way ? arg "-DPROFILING" , Threaded `wayUnit` way ? arg "-DTHREADED_RTS" , notM targetSupportsSMP ? pure [ "-DNOSMP" ===================================== includes/Cmm.h ===================================== @@ -660,7 +660,11 @@ #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1) #define TICK_ENT_DYN_IND() TICK_BUMP(ENT_DYN_IND_ctr) -#define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr) +// ENT_DYN_THK_ctr doesn't exist anymore. Could be ENT_DYN_THK_SINGLE_ctr or +// ENT_DYN_THK_MANY_ctr +// #define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr) +#define TICK_ENT_DYN_THK() + #define TICK_ENT_VIA_NODE() TICK_BUMP(ENT_VIA_NODE_ctr) #define TICK_ENT_STATIC_IND() TICK_BUMP(ENT_STATIC_IND_ctr) #define TICK_ENT_PERM_IND() TICK_BUMP(ENT_PERM_IND_ctr) ===================================== includes/stg/Ticky.h ===================================== @@ -199,18 +199,23 @@ EXTERN StgInt RET_UNBOXED_TUP_hst[TICKY_BIN_COUNT] INIT({0}); TICKY_TICKY is defined or not. */ #if !defined(CMINUSMINUS) +#if defined(TICKY_TICKY) #define TICK_BUMP_BY(ctr,n) ctr = (StgInt) ctr + n +#else +#define TICK_BUMP_BY(ctr,n) /* nothing */ +#endif + #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1) -#define TICK_ALLOC_PRIM(x,y,z) -#define TICK_UPD_OLD_IND() -#define TICK_UPD_NEW_IND() -#define TICK_UPD_SQUEEZED() -#define TICK_ALLOC_HEAP_NOCTR(bytes) -#define TICK_GC_FAILED_PROMOTION() -#define TICK_ALLOC_TSO() -#define TICK_ALLOC_STACK(g) -#define TICK_ALLOC_UP_THK(g,s) -#define TICK_ALLOC_SE_THK(g,s) +#define TICK_ALLOC_PRIM(x,y,z) // FIXME: update counter +#define TICK_UPD_OLD_IND() TICK_BUMP(UPD_OLD_IND_ctr) +#define TICK_UPD_NEW_IND() TICK_BUMP(UPD_NEW_IND_ctr) +#define TICK_UPD_SQUEEZED() TICK_BUMP(UPD_SQUEEZED_ctr) +#define TICK_ALLOC_HEAP_NOCTR(bytes) // FIXME: update counter +#define TICK_GC_FAILED_PROMOTION() // FIXME: update counter +#define TICK_ALLOC_TSO() // FIXME: update counter +#define TICK_ALLOC_STACK(g) // FIXME: update counter +#define TICK_ALLOC_UP_THK(g,s) // FIXME: update counter +#define TICK_ALLOC_SE_THK(g,s) // FIXME: update counter #endif ===================================== mk/ways.mk ===================================== @@ -70,7 +70,7 @@ WAY_thr_l_HC_OPTS= -static -optc-DTHREADED_RTS -eventlog # Way 'debug': WAY_debug_NAME=debug -WAY_debug_HC_OPTS= -static -optc-DDEBUG -ticky -DTICKY_TICKY -eventlog +WAY_debug_HC_OPTS= -static -optc-DDEBUG -ticky -DTICKY_TICKY -optc-DTICKY_TICKY -eventlog # Way 'debug_p': WAY_debug_p_NAME=debug profiled @@ -110,7 +110,7 @@ WAY_thr_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DTHREADED_RTS -optc-DDEBUG -event # Way 'debug_dyn': WAY_debug_dyn_NAME=debug_dyn -WAY_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DDEBUG -ticky -DTICKY_TICKY -eventlog +WAY_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DDEBUG -ticky -DTICKY_TICKY -optc-DTICKY_TICKY -eventlog # Way 'l_dyn': WAY_l_dyn_NAME=event logging dynamic ===================================== rts/Ticky.c ===================================== @@ -261,7 +261,7 @@ PrintTickyInfo(void) * * This of course refers to the -ticky version that uses PERM_INDs to * determine the number of closures entered 0/1/>1. KSW 1999-04. */ - COND_PR_CTR(ENT_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"E!NT_PERM_IND_ctr requires +RTS -Z"); + COND_PR_CTR(ENT_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"ENT_PERM_IND_ctr requires +RTS -Z"); PR_CTR(ENT_AP_ctr); PR_CTR(ENT_PAP_ctr); @@ -334,10 +334,10 @@ PrintTickyInfo(void) PR_CTR(UPD_NEW_IND_ctr); /* see comment on ENT_PERM_IND_ctr */ - COND_PR_CTR(UPD_NEW_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"U!PD_NEW_PERM_IND_ctr requires +RTS -Z"); + COND_PR_CTR(UPD_NEW_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"UPD_NEW_PERM_IND_ctr requires +RTS -Z"); PR_CTR(UPD_OLD_IND_ctr); /* see comment on ENT_PERM_IND_ctr */ - COND_PR_CTR(UPD_OLD_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"U!PD_OLD_PERM_IND_ctr requires +RTS -Z"); + COND_PR_CTR(UPD_OLD_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"UPD_OLD_PERM_IND_ctr requires +RTS -Z"); PR_CTR(GC_SEL_ABANDONED_ctr); PR_CTR(GC_SEL_MINOR_ctr); ===================================== utils/haddock ===================================== @@ -1 +1 @@ -Subproject commit e514a52a496d1ec216568deec374872b4b5251a6 +Subproject commit b95f6f29899a8a58223732a6633a47a35b8f1d6a View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1085826b9b5ef2404fc070dff9967d2d0f375b11...d241dc01d4fd70c9018e193869e5d5641170d039 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1085826b9b5ef2404fc070dff9967d2d0f375b11...d241dc01d4fd70c9018e193869e5d5641170d039 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 03:35:38 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Thu, 10 Sep 2020 23:35:38 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/ghc-8.10-backport-rpath Message-ID: <5f5af08a9c580_80b3f8458ff15c4115114fb@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/ghc-8.10-backport-rpath at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/ghc-8.10-backport-rpath You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 03:51:51 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Thu, 10 Sep 2020 23:51:51 -0400 Subject: [Git][ghc/ghc][wip/angerman/ghc-8.10-backport-rpath] [macOS] improved runpath handling Message-ID: <5f5af4577aea4_80b3f849b65dab0115146ab@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/ghc-8.10-backport-rpath at Glasgow Haskell Compiler / GHC Commits: e2ff3698 by Moritz Angermann at 2020-09-11T11:51:22+08:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) (cherry picked from commit 4ff93292243888545da452ea4d4c1987f2343591) Signed-off-by: Moritz Angermann <moritz.angermann at iohk.io> - - - - - 16 changed files: - aclocal.m4 - compiler/ghci/Linker.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Settings.hs - compiler/main/SysTools/Tasks.hs - configure.ac - docs/users_guide/phases.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - mk/config.mk.in - testsuite/tests/rts/all.T Changes: ===================================== aclocal.m4 ===================================== @@ -578,6 +578,18 @@ AC_DEFUN([FP_SETTINGS], else SettingsOptCommand="$OptCmd" fi + if test -z "$OtoolCmd" + then + SettingsOtoolCommand="otool" + else + SettingsOtoolCommand="$OtoolCmd" + fi + if test -z "$InstallNameToolCmd" + then + SettingsInstallNameToolCommand="install_name_tool" + else + SettingsInstallNameToolCommand="$InstallNameToolCmd" + fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -594,6 +606,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/ghci/Linker.hs ===================================== @@ -913,20 +913,22 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -382,7 +382,56 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commands. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc's ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1769,9 +1818,12 @@ linkBinary' staticLink dflags o_files dep_packages = do rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then SysTools.runLibtool - else SysTools.runLink + let link dflags args | staticLink = SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = SysTools.runLink dflags args >> SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = SysTools.runLink dflags args + link dflags ( map SysTools.Option verbFlags ++ [ SysTools.Option "-o" @@ -1838,7 +1890,13 @@ linkBinary' staticLink dflags o_files dep_packages = do ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/main/DynFlags.hs ===================================== @@ -155,8 +155,8 @@ module DynFlags ( versionedAppDir, versionedFilePath, extraGccViaCFlags, systemPackageConfig, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, + pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool, + pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -1463,6 +1463,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags +pgm_otool :: DynFlags -> String +pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) @@ -3089,6 +3093,10 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } + , make_ord_flag defFlag "pgmotool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f} + , make_ord_flag defFlag "pgminstall_name_tool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f} , make_ord_flag defFlag "pgmranlib" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } @@ -4589,7 +4597,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -4600,6 +4607,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -4640,6 +4649,29 @@ default_PIC platform = -- information. _ -> [] + +-- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS +-- versions the number of load commands we can embed in a dynamic library is +-- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only +-- link the needed dylibs instead of linking the full dependency closure. +-- +-- If we split the library linking into injecting -rpath and -l @rpath/... +-- components, we will reduce the number of libraries we link, however we will +-- still inject one -rpath entry for each library, independent of their use. +-- That is, we even inject -rpath values for libraries that we dead_strip in +-- the end. As such we can run afoul of the load command size limit simply +-- by polluting the load commands with RPATH entries. +-- +-- Thus, we disable Opt_RPath by default on OSDarwin. The savvy user can always +-- enable it with -use-rpath if they so wish. +-- +-- See Note [Dynamic linking on macOS] + +default_RPath :: Platform -> [GeneralFlag] +default_RPath platform | platformOS platform == OSDarwin = [] +default_RPath _ = [Opt_RPath] + + -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] ===================================== compiler/main/Settings.hs ===================================== @@ -25,6 +25,8 @@ module Settings , sPgm_windres , sPgm_libtool , sPgm_ar + , sPgm_otool + , sPgm_install_name_tool , sPgm_ranlib , sPgm_lo , sPgm_lc @@ -139,6 +141,10 @@ sPgm_libtool :: Settings -> String sPgm_libtool = toolSettings_pgm_libtool . sToolSettings sPgm_ar :: Settings -> String sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_otool :: Settings -> String +sPgm_otool = toolSettings_pgm_otool . sToolSettings +sPgm_install_name_tool :: Settings -> String +sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings sPgm_ranlib :: Settings -> String sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings sPgm_lo :: Settings -> (String, [Option]) ===================================== compiler/main/SysTools.hs ===================================== @@ -254,7 +254,10 @@ linkDynLib dflags0 o_files dep_packages | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `elem` ways dflags + -- Only if we want dynamic libraries + WayDyn `elem` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -377,8 +380,15 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the leftover + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO ===================================== compiler/main/SysTools/Settings.hs ===================================== @@ -119,6 +119,8 @@ initSettings top_dir = do windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -210,6 +212,8 @@ initSettings top_dir = do , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) ===================================== compiler/main/SysTools/Tasks.hs ===================================== @@ -28,6 +28,10 @@ import LlvmCodeGen.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pars import SysTools.Process import SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,41 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included in the load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of libraries end up being truely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath at . +-- +-- See Note [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + -- find any pre-existing LC_PATH items + info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib] + let paths = concatMap f info + where f ("path":p:_) = [p] + f _ = [] + lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ] + -- only find those rpaths, that aren't already in the library. + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths') + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -335,6 +374,17 @@ askAr dflags mb_cwd args = traceToolCommand dflags "ar" $ do runSomethingWith dflags "Ar" ar args $ \real_args -> readCreateProcessWithExitCode' (proc ar real_args){ cwd = mb_cwd } +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing + runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do let ranlib = pgm_ranlib dflags ===================================== configure.ac ===================================== @@ -669,6 +669,18 @@ else fi AC_SUBST([LibtoolCmd]) +dnl ** Which otool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([OTOOL], [otool]) +OtoolCmd="$OTOOL" +AC_SUBST(OtoolCmd) + +dnl ** Which install_name_tool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool]) +InstallNameToolCmd="$INSTALL_NAME_TOOL" +AC_SUBST(InstallNameToolCmd) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -1479,6 +1491,8 @@ echo "\ libtool : $LibtoolCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd + otool : $OtoolCmd + install_name_tool : $InstallNameToolCmd windres : $WindresCmd dllwrap : $DllWrapCmd genlib : $GenlibCmd ===================================== docs/users_guide/phases.rst ===================================== @@ -95,6 +95,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only). +.. ghc-flag:: -pgmotool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inspect mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and + executables to read the dynamic library dependencies. We will compute + the necessary ``runpath``s to embed for the dependencies based on the + result of the ``otool`` call. + +.. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inject ``runpath`` into mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inject ``runpath``s into mach-o dynamic + libraries and executables. As detected by the ``otool`` call. + .. ghc-flag:: -pgmwindres ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the program for embedding manifests on Windows. :type: dynamic ===================================== hadrian/cfg/system.config.in ===================================== @@ -147,6 +147,8 @@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ +settings-otool-command = @SettingsOtoolCommand@ +settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-libtool-command = @SettingsLibtoolCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -113,6 +113,8 @@ data SettingsFileSetting | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_OtoolCommand + | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_LibtoolCommand @@ -198,6 +200,8 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_OtoolCommand -> "settings-otool-command" + SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -294,6 +294,8 @@ generateSettings = do , ("ar flags", expr $ lookupValueOrError configFile "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) ===================================== includes/ghc.mk ===================================== @@ -228,6 +228,8 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ + @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -515,6 +515,8 @@ SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ ===================================== testsuite/tests/rts/all.T ===================================== @@ -403,7 +403,7 @@ test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp - test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug']) test('T13676', - [when(opsys('darwin') or opsys('mingw32'), expect_broken(17447)), + [when(opsys('mingw32'), expect_broken(17447)), extra_files(['T13676.hs'])], ghci_script, ['T13676.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2ff36980ba057b81fddd66f150e4f071f36cee0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e2ff36980ba057b81fddd66f150e4f071f36cee0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 05:20:23 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Fri, 11 Sep 2020 01:20:23 -0400 Subject: [Git][ghc/ghc] Pushed new branch wip/angerman/ghc-8.8-backport-rpath Message-ID: <5f5b09179f2aa_80b105aaf7c11515218@gitlab.haskell.org.mail> Moritz Angermann pushed new branch wip/angerman/ghc-8.8-backport-rpath at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/angerman/ghc-8.8-backport-rpath You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 05:34:34 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Fri, 11 Sep 2020 01:34:34 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] 4 commits: [Aarch64] No div-by-zero; disable test. Message-ID: <5f5b0c6a1027f_80b3f849023c7d411516822@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: 8009d84f by Moritz Angermann at 2020-09-09T15:34:03+00:00 [Aarch64] No div-by-zero; disable test. - - - - - cb99c9c9 by Moritz Angermann at 2020-09-11T02:25:50+00:00 Simplify aarch64 StgRun We don't need to do the callee save register dance. The compiler will do this for us already: 0000000000000000 <StgRun>: 0: a9b653f3 stp x19, x20, [sp, #-160]! 4: a9015bf5 stp x21, x22, [sp, #16] 8: a90263f7 stp x23, x24, [sp, #32] c: a9036bf9 stp x25, x26, [sp, #48] 10: a90473fb stp x27, x28, [sp, #64] 14: f9002bfe str x30, [sp, #80] 18: 6d0627e8 stp d8, d9, [sp, #96] 1c: 6d072fea stp d10, d11, [sp, #112] 20: 6d0837ec stp d12, d13, [sp, #128] 24: 6d093fee stp d14, d15, [sp, #144] 28: a9bf47f0 stp x16, x17, [sp, #-16]! 2c: d14013ff sub sp, sp, #0x4, lsl #12 30: aa0103f3 mov x19, x1 34: d61f0000 br x0 0000000000000038 <StgReturn>: 38: 914013ff add sp, sp, #0x4, lsl #12 3c: aa1603e0 mov x0, x22 40: a8c147f0 ldp x16, x17, [sp], #16 44: a9415bf5 ldp x21, x22, [sp, #16] 48: a94263f7 ldp x23, x24, [sp, #32] 4c: a9436bf9 ldp x25, x26, [sp, #48] 50: a94473fb ldp x27, x28, [sp, #64] 54: f9402bfe ldr x30, [sp, #80] 58: 6d4627e8 ldp d8, d9, [sp, #96] 5c: 6d472fea ldp d10, d11, [sp, #112] 60: 6d4837ec ldp d12, d13, [sp, #128] 64: 6d493fee ldp d14, d15, [sp, #144] 68: a8ca53f3 ldp x19, x20, [sp], #160 6c: d65f03c0 ret - - - - - 795a3a8d by Moritz Angermann at 2020-09-11T02:25:50+00:00 Use ip0 for spills/reloads - - - - - 1ca1fe4e by Moritz Angermann at 2020-09-11T05:34:14+00:00 :broom: Cleanup imports/unused args - - - - - 8 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Regs.hs - compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs - compiler/GHC/CmmToAsm/SPARC/Instr.hs - includes/CodeGen.Platform.hs - rts/StgCRun.c - testsuite/tests/rts/all.T Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -34,14 +34,14 @@ import GHC.CmmToAsm.Instr import GHC.CmmToAsm.PIC import GHC.CmmToAsm.Format import GHC.CmmToAsm.Config -import GHC.Platform.Reg.Class +-- import GHC.Platform.Reg.Class import GHC.Platform.Reg -import GHC.CmmToAsm.Reg.Target +-- import GHC.CmmToAsm.Reg.Target import GHC.Platform -- Our intermediate code: import GHC.Cmm.BlockId -import GHC.Cmm.Ppr ( pprExpr ) +-- import GHC.Cmm.Ppr ( pprExpr ) import GHC.Cmm import GHC.Cmm.Utils import GHC.Cmm.Switch @@ -59,7 +59,7 @@ import Control.Monad ( mapAndUnzipM, when, foldM ) import Data.Bits import Data.Word import Data.Maybe -import Data.Int +-- import Data.Int import GHC.Float import GHC.Types.Basic @@ -67,7 +67,7 @@ import GHC.Types.ForeignCall import GHC.Data.FastString import GHC.Utils.Misc -import Debug.Trace +-- import Debug.Trace -- @cmmTopCodeGen@ will be our main entry point to code gen. Here we'll get -- @RawCmmDecl@; see GHC.Cmm @@ -113,11 +113,9 @@ cmmTopCodeGen _cmm@(CmmProc info lab live graph) = do let blocks = toBlockListEntryFirst graph (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks picBaseMb <- getPicBaseMaybeNat - platform <- getPlatform let proc = CmmProc info lab live (ListGraph $ concat nat_blocks) tops = proc : concat statics - os = platformOS platform case picBaseMb of Just _picBase -> panic "AArch64.cmmTopCodeGen: picBase not implemented" @@ -332,10 +330,11 @@ getRegisterReg platform (CmmGlobal mid) -- platform. Hence ... -- | Convert a BlockId to some CmmStatic data -jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic -jumpTableEntry config Nothing = CmmStaticLit (CmmInt 0 (ncgWordWidth config)) -jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel) - where blockLabel = blockLbl blockid +-- XXX: Add JumpTable Logic +-- jumpTableEntry :: NCGConfig -> Maybe BlockId -> CmmStatic +-- jumpTableEntry config Nothing = CmmStaticLit (CmmInt 0 (ncgWordWidth config)) +-- jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel) +-- where blockLabel = blockLbl blockid -- ----------------------------------------------------------------------------- -- Utility @@ -879,7 +878,6 @@ assignMem_IntCode rep addrE srcE (src_reg, _format, code) <- getSomeReg srcE platform <- getPlatform Amode addr addr_code <- getAmode platform addrE - let AddrReg r1 = addr return $ COMMENT (text "CmmStore" <+> parens (text (show addrE)) <+> parens (text (show srcE))) `consOL` (code `appOL` addr_code @@ -889,8 +887,6 @@ assignReg_IntCode _ reg src = do platform <- getPlatform let dst = getRegisterReg platform reg - p :: Outputable a => a -> String - p = showSDocUnsafe . ppr r <- getRegister src return $ case r of Any _ code -> COMMENT (text "CmmAssign" <+> parens (text (show reg)) <+> parens (text (show src))) `consOL` code dst @@ -980,7 +976,8 @@ genCondJump bid expr = do MO_U_Ge w -> bcond w UGE MO_U_Lt w -> bcond w ULT MO_U_Le w -> bcond w ULE - _ -> pprPanic "AArch64.genCondJump: " (ppr expr) + _ -> pprPanic "AArch64.genCondJump:case mop: " (text $ show expr) + _ -> pprPanic "AArch64.genCondJump: " (text $ show expr) genCondBranch @@ -1234,8 +1231,6 @@ genCCall target dest_regs arg_regs bid = do -- XXX: this should be implemented properly! MO_Xchg w -> mkCCall (xchgLabel w) - _ -> pprPanic "genCCall:PrimTarget" (ppr target) - where unsupported :: Show a => a -> b unsupported mop = panic ("outOfLineCmmOp: " ++ show mop ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -13,9 +13,9 @@ import GHC.CmmToAsm.AArch64.Regs import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Format -import GHC.CmmToAsm.Reg.Target +-- import GHC.CmmToAsm.Reg.Target import GHC.CmmToAsm.Config -import GHC.Platform.Reg.Class +-- import GHC.Platform.Reg.Class import GHC.Platform.Reg import GHC.Platform.Regs @@ -23,18 +23,18 @@ import GHC.Cmm.BlockId import GHC.Cmm.Dataflow.Collections import GHC.Cmm.Dataflow.Label import GHC.Cmm -import GHC.Cmm.Info -import GHC.Data.FastString +-- import GHC.Cmm.Info +-- import GHC.Data.FastString import GHC.Cmm.CLabel import GHC.Utils.Outputable import GHC.Platform -import GHC.Types.Unique.FM (listToUFM, lookupUFM) +-- import GHC.Types.Unique.FM (listToUFM, lookupUFM) import GHC.Types.Unique.Supply import Control.Monad (replicateM) import Data.Maybe (fromMaybe) -import Debug.Trace +-- import Debug.Trace import GHC.Stack import Data.Bits ((.&.), complement) @@ -115,7 +115,6 @@ aarch64_regUsageOfInstr platform instr = case instr of -- 3. Logical and Move Instructions ------------------------------------------ AND dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - ADDS dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) ASR dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BIC dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) BICS dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) @@ -183,7 +182,7 @@ aarch64_regUsageOfInstr platform instr = case instr of -- Is this register interesting for the register allocator? interesting :: Platform -> Reg -> Bool interesting _ (RegVirtual _) = True - interesting platform (RegReal (RealRegSingle (-1))) = False + interesting _ (RegReal (RealRegSingle (-1))) = False interesting platform (RegReal (RealRegSingle i)) = freeReg platform i interesting _ (RegReal (RealRegPair{})) = panic "AArch64.Instr.interesting: no reg pairs on this arch" @@ -280,6 +279,7 @@ aarch64_patchRegsOfInstr instr env = case instr of SCVTF o1 o2 -> SCVTF (patchOp o1) (patchOp o2) FCVTZS o1 o2 -> FCVTZS (patchOp o1) (patchOp o2) + _ -> pprPanic "aarch64_patchRegsOfInstr" (text $ show instr) where patchOp :: Operand -> Operand patchOp (OpReg w r) = OpReg w (env r) @@ -338,7 +338,21 @@ aarch64_patchJumpInstr instr patchF _ -> pprPanic "patchJumpInstr" (text $ show instr) -- ----------------------------------------------------------------------------- - +-- Note [Spills and Reloads] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~ +-- We reserve @RESERVED_C_STACK_BYTES@ on the C stack for spilling and reloading +-- registers. AArch64s maximum displacement for SP relative spills and reloads +-- is essentially [-256,255], or [0, 0xFFF]*8 = [0, 32760] for 64bits. +-- +-- The @RESERVED_C_STACK_BYTES@ is 16k, so we can't address any location in a +-- single instruction. The idea is to use the Inter Procedure 0 (ip0) register +-- to perform the computations for larger offsets. +-- +-- Using sp to compute the offset will violate assumptions about the stack pointer +-- pointing to the top of the stack during signal handling. As we can't force +-- every signal to use its own stack, we have to ensure that the stack poitner +-- always poitns to the top of the stack, and we can't use it for computation. +-- -- | An instruction to spill a register into a spill slot. aarch64_mkSpillInstr :: HasCallStack @@ -348,35 +362,13 @@ aarch64_mkSpillInstr -> Int -- spill slot to use -> [Instr] --- Alright, so here's the plan. On aarch64, we can't spill into arbitrary locations, --- the range is essentially [-256,255], or [0, 0xFFF]*8 = [0, 32760] for 64bits. For --- other ranges we need to adjust SP first; we should strive to keep it 16byte aligned. --- --- To adjust for other range, we can use ADD/SUB, with a positive immediate of [0, 0xFFF], --- or [0, 0xFFF] << 12. - aarch64_mkSpillInstr config reg delta slot = case (spillSlotToOffset config slot) - delta of - imm | -256 <= imm && imm <= 255 -> [ mkStr imm ] - imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkStr imm ] - imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkAdd (imm .&~. 0xfff) - , mkStr (imm .&. 0xfff) - , mkSub (imm .&~. 0xfff) ] - -- imm | imm > 0xfff && imm <= 0xffffff -> [ mkAdd (imm .&~. 0xfff) - -- , mkAdd (imm .&. 0xff0) - -- , mkStr (imm .&. 0x00f) - -- , mkSub (imm .&. 0xff0) - -- , mkSub (imm .&~. 0xfff) ] - -- if we have a negative offset, well subtract another 0x1000 from it, and then - -- use the positive - -- imm | -imm > 0xfff && -imm <= 0xffefff && imm .&. 0x7 == 0x0 -> [ mkSub (-imm .&~. 0xfff + 0x1000) - -- , mkStr (0x1000 - (-imm .&. 0xfff)) - -- , mkAdd (-imm .&~. 0xfff + 0x1000) ] - -- imm | -imm > 0xfff && -imm <= 0xffffff -> [ mkSub (-imm .&~. 0xfff) - -- , mkSub (-imm .&. 0xff0) - -- , mkStr (-(-imm .&. 0x00f)) - -- , mkAdd (-imm .&. 0xff0) - -- , mkAdd (-imm .&~. 0xfff) ] + imm | -256 <= imm && imm <= 255 -> [ mkStrSp imm ] + imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkStrSp imm ] + imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkIp0SpillAddr (imm .&~. 0xfff) + , mkStrIp0 (imm .&. 0xfff) + ] imm -> pprPanic "aarch64_mkSpillInstr" (text "Unable to spill into" <+> int imm) where a .&~. b = a .&. (complement b) @@ -384,14 +376,12 @@ aarch64_mkSpillInstr config reg delta slot = fmt = case reg of RegReal (RealRegSingle n) | n < 32 -> II64 _ -> FF64 - - mkStr imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) - mkAdd imm = ANN (text "Spill Add") $ ADD sp sp (OpImm (ImmInt imm)) - mkSub imm = ANN (text "Spill Sub") $ SUB sp sp (OpImm (ImmInt imm)) + mkIp0SpillAddr imm = ANN (text "Spill: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) + mkStrSp imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) + mkStrIp0 imm = ANN (text "Spill@" <> int (off - delta)) $ STR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 16) (ImmInt imm))) off = spillSlotToOffset config slot --- fails in compiler/stage2/build/GHC/Driver/Pipeline.o aarch64_mkLoadInstr :: NCGConfig -> Reg -- register to load @@ -401,26 +391,11 @@ aarch64_mkLoadInstr aarch64_mkLoadInstr config reg delta slot = case (spillSlotToOffset config slot) - delta of - imm | -256 <= imm && imm <= 255 -> [ mkLdr imm ] - imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkLdr imm ] - imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkAdd (imm .&~. 0xfff) - , mkLdr (imm .&. 0xfff) - , mkSub (imm .&~. 0xfff) ] - -- imm | imm > 0xfff && imm <= 0xffffff -> [ mkAdd (imm .&~. 0xfff) - -- , mkAdd (imm .&. 0xff0) - -- , mkLdr (imm .&. 0x00f) - -- , mkSub (imm .&. 0xff0) - -- , mkSub (imm .&~. 0xfff) ] - -- if we have a negative offset, well subtract another 0x1000 from it, and then - -- use the positive - -- imm | -imm > 0xfff && -imm <= 0xffefff && imm .&. 0x7 == 0x0 -> [ mkSub (-imm .&~. 0xfff + 0x1000) - -- , mkLdr (0x1000 - (-imm .&. 0xfff)) - -- , mkAdd (-imm .&~. 0xfff + 0x1000) ] - -- imm | -imm > 0xfff && -imm <= 0xffffff -> [ mkSub (-imm .&~. 0xfff) - -- , mkSub (-imm .&. 0xff0) - -- , mkLdr (-(-imm .&. 0x00f)) - -- , mkAdd (-imm .&. 0xff0) - -- , mkAdd (-imm .&~. 0xfff) ] + imm | -256 <= imm && imm <= 255 -> [ mkLdrSp imm ] + imm | imm > 0 && imm .&. 0x7 == 0x0 && imm <= 0xfff -> [ mkLdrSp imm ] + imm | imm > 0xfff && imm <= 0xffffff && imm .&. 0x7 == 0x0 -> [ mkIp0SpillAddr (imm .&~. 0xfff) + , mkLdrIp0 (imm .&. 0xfff) + ] imm -> pprPanic "aarch64_mkSpillInstr" (text "Unable to spill into" <+> int imm) where a .&~. b = a .&. (complement b) @@ -429,9 +404,9 @@ aarch64_mkLoadInstr config reg delta slot = RegReal (RealRegSingle n) | n < 32 -> II64 _ -> FF64 - mkLdr imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) - mkAdd imm = ANN (text "Reload Add") $ ADD sp sp (OpImm (ImmInt imm)) - mkSub imm = ANN (text "Reload Sub") $ SUB sp sp (OpImm (ImmInt imm)) + mkIp0SpillAddr imm = ANN (text "Reload: IP0 <- SP + " <> int imm) $ ADD ip0 sp (OpImm (ImmInt imm)) + mkLdrSp imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 31) (ImmInt imm))) + mkLdrIp0 imm = ANN (text "Reload@" <> int (off - delta)) $ LDR fmt (OpReg W64 reg) (OpAddr (AddrRegImm (regSingle 16) (ImmInt imm))) off = spillSlotToOffset config slot @@ -477,14 +452,14 @@ aarch64_mkStackAllocInstr platform n | n == 0 = [] | n > 0 && n < 4096 = [ ANN (text "Alloc More Stack") $ SUB sp sp (OpImm (ImmInt n)) ] | n > 0 = ANN (text "Alloc More Stack") (SUB sp sp (OpImm (ImmInt 4095))) : aarch64_mkStackAllocInstr platform (n - 4095) -aarch64_mkStackAllocInstr platform n = pprPanic "aarch64_mkStackAllocInstr" (int n) +aarch64_mkStackAllocInstr _platform n = pprPanic "aarch64_mkStackAllocInstr" (int n) aarch64_mkStackDeallocInstr :: Platform -> Int -> [Instr] aarch64_mkStackDeallocInstr platform n | n == 0 = [] | n > 0 && n < 4096 = [ ANN (text "Dealloc More Stack") $ ADD sp sp (OpImm (ImmInt n)) ] | n > 0 = ANN (text "Dealloc More Stack") (ADD sp sp (OpImm (ImmInt 4095))) : aarch64_mkStackDeallocInstr platform (n - 4095) -aarch64_mkStackDeallocInstr platform n = pprPanic "aarch64_mkStackDeallocInstr" (int n) +aarch64_mkStackDeallocInstr _platform n = pprPanic "aarch64_mkStackDeallocInstr" (int n) -- -- See note [extra spill slots] in X86/Instr.hs @@ -668,7 +643,7 @@ data Instr | FCVTZS Operand Operand instance Show Instr where - show (LDR f o1 o2) = "LDR " ++ show o1 ++ ", " ++ show o2 + show (LDR _f o1 o2) = "LDR " ++ show o1 ++ ", " ++ show o2 show (MOV o1 o2) = "MOV " ++ show o1 ++ ", " ++ show o2 show _ = "missing" @@ -709,10 +684,11 @@ data Operand opReg :: Width -> Reg -> Operand opReg = OpReg -xzr, wzr, sp :: Operand +xzr, wzr, sp, ip0 :: Operand xzr = OpReg W64 (RegReal (RealRegSingle (-1))) wzr = OpReg W32 (RegReal (RealRegSingle (-1))) sp = OpReg W64 (RegReal (RealRegSingle 31)) +ip0 = OpReg W64 (RegReal (RealRegSingle 16)) _x :: Int -> Operand _x i = OpReg W64 (RegReal (RealRegSingle i)) @@ -797,9 +773,11 @@ opRegUExt W64 r = OpRegExt W64 r EUXTX 0 opRegUExt W32 r = OpRegExt W32 r EUXTW 0 opRegUExt W16 r = OpRegExt W16 r EUXTH 0 opRegUExt W8 r = OpRegExt W8 r EUXTB 0 +opRegUExt w _r = pprPanic "opRegUExt" (text $ show w) opRegSExt :: Width -> Reg -> Operand opRegSExt W64 r = OpRegExt W64 r ESXTX 0 opRegSExt W32 r = OpRegExt W32 r ESXTW 0 opRegSExt W16 r = OpRegExt W16 r ESXTH 0 -opRegSExt W8 r = OpRegExt W8 r ESXTB 0 \ No newline at end of file +opRegSExt W8 r = OpRegExt W8 r ESXTB 0 +opRegSExt w _r = pprPanic "opRegSExt" (text $ show w) ===================================== compiler/GHC/CmmToAsm/AArch64/Regs.hs ===================================== @@ -9,7 +9,7 @@ import GHC.Prelude import GHC.Platform.Reg import GHC.Platform.Reg.Class import GHC.CmmToAsm.Format -import GHC.CmmToAsm.Config +-- import GHC.CmmToAsm.Config import GHC.Cmm import GHC.Cmm.CLabel ( CLabel ) @@ -19,8 +19,8 @@ import GHC.Platform.Regs import GHC.Utils.Outputable import GHC.Platform -import Data.Word ( Word8, Word16, Word32, Word64 ) -import Data.Int ( Int8, Int16, Int32, Int64 ) +-- import Data.Word ( Word8, Word16, Word32, Word64 ) +-- import Data.Int ( Int8, Int16, Int32, Int64 ) allMachRegNos :: [RegNo] allMachRegNos = [0..31] ++ [32..63] ===================================== compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs ===================================== @@ -12,7 +12,7 @@ import GHC.Platform import Data.Word import Data.Bits -import Debug.Trace +-- import Debug.Trace import GHC.Stack -- AArch64 has 32 64bit general purpose register r0..r30, and zr/sp -- AArch64 has 32 128bit floating point registers v0..v31 as part of the NEON @@ -122,7 +122,7 @@ getFreeRegs cls (FreeRegs g f) | RcDouble <- cls = go 32 f 31 | RcInteger <- cls = go 0 g 18 where - go off _ i | i < 0 = [] + go _ _ i | i < 0 = [] go off x i | testBit x i = RealRegSingle (off + i) : (go off x $! i - 1) | otherwise = go off x $! i - 1 ===================================== compiler/GHC/CmmToAsm/SPARC/Instr.hs ===================================== @@ -376,7 +376,7 @@ sparc_mkSpillInstr -> Int -- ^ spill slot to use -> [Instr] -sparc_mkSpillInstr config reg delta slot +sparc_mkSpillInstr config reg _delta slot = let platform = ncgPlatform config off = spillSlotToOffset config slot off_w = 1 + (off `div` 4) @@ -396,7 +396,7 @@ sparc_mkLoadInstr -> Int -- ^ spill slot to use -> [Instr] -sparc_mkLoadInstr config reg delta slot +sparc_mkLoadInstr config reg _delta slot = let platform = ncgPlatform config off = spillSlotToOffset config slot off_w = 1 + (off `div` 4) ===================================== includes/CodeGen.Platform.hs ===================================== @@ -957,7 +957,8 @@ freeReg 31 = False freeReg 30 = False -- frame pointer freeReg 29 = False - +-- ip0 -- used for spill offset computations +freeReg 16 = False # if defined(REG_Base) freeReg REG_Base = False ===================================== rts/StgCRun.c ===================================== @@ -883,30 +883,41 @@ StgRun(StgFunPtr f, StgRegTable *basereg) { #if defined(aarch64_HOST_ARCH) +/* See also AArch64/Instr.hs + * + * Save caller save registers + * This is x0-x18 + * + * For SIMD/FP Registers: + * Registers v8-v15 must be preserved by a callee across subroutine calls; + * the remaining registers (v0-v7, v16-v31) do not need to be preserved (or + * should be preserved by the caller). Additionally, only the bottom 64 bits + * of each value stored in v8-v15 need to be preserved [7]; it is the + * responsibility of the caller to preserve larger values. + * + * .---------------------------------------------------------------------------------------------------------------------------------------------------------------. + * | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | + * | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 42 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | + * |== General Purpose registers ==================================================================================================================================| + * | <---- argument passing -------------> | IR | <------- tmp registers --------> | IP0| IP1| PL | <------------------- callee saved ------------> | FP | LR | SP | + * | <------ free registers --------------------------------------------------------------------> | BR | Sp | Hp | R1 | R2 | R3 | R4 | R5 | R6 | SL | -- | -- | -- | + * |== SIMD/FP Registers ==========================================================================================================================================| + * | <---- argument passing -------------> | <-- callee saved (lower 64 bits) ---> | <--------------------------------------- caller saved ----------------------> | + * | <------ free registers -------------> | F1 | F2 | F3 | F4 | D1 | D2 | D3 | D4 | <------ free registers -----------------------------------------------------> | + * '---------------------------------------------------------------------------------------------------------------------------------------------------------------' + * IR: Indirect result location register, IP: Intra-procedure register, PL: Platform register, FP: Frame pointer, LR: Link register, SP: Stack pointer + * BR: Base, SL: SpLim + */ + StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg) { StgRegTable * r; __asm__ volatile ( /* * Save callee-saves registers on behalf of the STG code. - * Floating point registers only need the bottom 64 bits preserved. - * We need to use the names x16, x17, x29 and x30 instead of ip0 - * ip1, fp and lp because one of either clang or gcc doesn't understand - * the later names. + * Note: The compiler will insert this for us if we specify the + * Clobbered correctly. See below. */ - "stp x29, x30, [sp, #-16]!\n\t" - "mov x29, sp\n\t" - "stp x16, x17, [sp, #-16]!\n\t" - "stp x19, x20, [sp, #-16]!\n\t" - "stp x21, x22, [sp, #-16]!\n\t" - "stp x23, x24, [sp, #-16]!\n\t" - "stp x25, x26, [sp, #-16]!\n\t" - "stp x27, x28, [sp, #-16]!\n\t" - "stp d8, d9, [sp, #-16]!\n\t" - "stp d10, d11, [sp, #-16]!\n\t" - "stp d12, d13, [sp, #-16]!\n\t" - "stp d14, d15, [sp, #-16]!\n\t" - /* * allocate some space for Stg machine's temporary storage. * Note: RESERVED_C_STACK_BYTES has to be a round number here or @@ -935,26 +946,28 @@ StgRun(StgFunPtr f, StgRegTable *basereg) { * Return the new register table, taking it from Stg's R1 (ARM64's R22). */ "mov %0, x22\n\t" - /* - * restore callee-saves registers. - */ - "ldp d14, d15, [sp], #16\n\t" - "ldp d12, d13, [sp], #16\n\t" - "ldp d10, d11, [sp], #16\n\t" - "ldp d8, d9, [sp], #16\n\t" - "ldp x27, x28, [sp], #16\n\t" - "ldp x25, x26, [sp], #16\n\t" - "ldp x23, x24, [sp], #16\n\t" - "ldp x21, x22, [sp], #16\n\t" - "ldp x19, x20, [sp], #16\n\t" - "ldp x16, x17, [sp], #16\n\t" - "ldp x29, x30, [sp], #16\n\t" + /* Restore callee-saves register + * Note: The compiler will insert this for us if we specify the + * Clobbered correctly. See below. + */ + /* Outputs (r) */ : "=r" (r) + /* Inputs (f, regbase, RESERVED_C_STACK_BYTES) */ : "r" (f), "r" (basereg), "i" (RESERVED_C_STACK_BYTES) - : "%x19", "%x20", "%x21", "%x22", "%x23", "%x24", "%x25", "%x26", "%x27", "%x28", - "%x16", "%x17", "%x30" + /* Clobbered */ + : // any of the stg calls may directly or indirectly modify these: + "%x19", "%x20", "%x21", "%x22", "%x23", "%x24", "%x25", "%x26", "%x27", "%x28", + // the IP usually, not, but better safe than sorry. However, I'm not sure + // we even have to save them. There is no expectation they survive a call. + "%x16", "%x17", + // The Link Register will hold the point we want to return to; and we may + // overwrite it with BL instructions in the haskell code. + "%x30", + // floating point registers + "%d8", "%d9", "%d10", "%d11", "%d12", "%d13", "%d14", "%d15", + "memory" ); return r; } ===================================== testsuite/tests/rts/all.T ===================================== @@ -50,6 +50,11 @@ test('divbyzero', # behavior on division-by-zero (#10332). omit_ways(llvm_ways), when(not(have_ncg()), skip), + # Aarch64 does not have div-by-zero exceptions for sdiv/udiv. + # The only option would be to implement this in assembly with checks for + # each devision. Neither gcc, nor llvm do this as of right now. Microsoft + # apparently does so though? + when(arch('aarch64'), skip), # Apparently the output can be different on different # Linux setups, so just ignore it. As long as we get # the right exit code we're OK. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0f422766833fe2a4747a94897100e9c99ac0164...1ca1fe4eca475cca2ec6037488778400a336ecf8 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c0f422766833fe2a4747a94897100e9c99ac0164...1ca1fe4eca475cca2ec6037488778400a336ecf8 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 05:41:44 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Fri, 11 Sep 2020 01:41:44 -0400 Subject: [Git][ghc/ghc][wip/angerman/ghc-8.10-backport-rpath] [macOS] improved runpath handling Message-ID: <5f5b0e1828b75_80b3f847779a17c115178cb@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/ghc-8.10-backport-rpath at Glasgow Haskell Compiler / GHC Commits: ffc00acc by Moritz Angermann at 2020-09-11T13:41:22+08:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) (cherry picked from commit 4ff93292243888545da452ea4d4c1987f2343591) Signed-off-by: Moritz Angermann <moritz.angermann at iohk.io> - - - - - 17 changed files: - aclocal.m4 - compiler/ghci/Linker.hs - compiler/main/DriverPipeline.hs - compiler/main/DynFlags.hs - compiler/main/Settings.hs - compiler/main/SysTools.hs - compiler/main/SysTools/Settings.hs - compiler/main/SysTools/Tasks.hs - compiler/main/ToolSettings.hs - configure.ac - docs/users_guide/phases.rst - hadrian/cfg/system.config.in - hadrian/src/Oracles/Setting.hs - hadrian/src/Rules/Generate.hs - includes/ghc.mk - mk/config.mk.in - testsuite/tests/rts/all.T Changes: ===================================== aclocal.m4 ===================================== @@ -578,6 +578,18 @@ AC_DEFUN([FP_SETTINGS], else SettingsOptCommand="$OptCmd" fi + if test -z "$OtoolCmd" + then + SettingsOtoolCommand="otool" + else + SettingsOtoolCommand="$OtoolCmd" + fi + if test -z "$InstallNameToolCmd" + then + SettingsInstallNameToolCommand="install_name_tool" + else + SettingsInstallNameToolCommand="$InstallNameToolCmd" + fi SettingsCCompilerFlags="$CONF_CC_OPTS_STAGE2" SettingsCxxCompilerFlags="$CONF_CXX_OPTS_STAGE2" SettingsCCompilerLinkFlags="$CONF_GCC_LINKER_OPTS_STAGE2" @@ -594,6 +606,8 @@ AC_DEFUN([FP_SETTINGS], AC_SUBST(SettingsLdFlags) AC_SUBST(SettingsArCommand) AC_SUBST(SettingsRanlibCommand) + AC_SUBST(SettingsOtoolCommand) + AC_SUBST(SettingsInstallNameToolCommand) AC_SUBST(SettingsDllWrapCommand) AC_SUBST(SettingsWindresCommand) AC_SUBST(SettingsLibtoolCommand) ===================================== compiler/ghci/Linker.hs ===================================== @@ -913,20 +913,22 @@ dynLoadObjs hsc_env pls at PersistentLinkerState{..} objs = do ldInputs = concatMap (\l -> [ Option ("-l" ++ l) ]) (nub $ snd <$> temp_sos) - ++ concatMap (\lp -> [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp ]) + ++ concatMap (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) (nub $ fst <$> temp_sos) ++ concatMap - (\lp -> - [ Option ("-L" ++ lp) - , Option "-Xlinker" - , Option "-rpath" - , Option "-Xlinker" - , Option lp - ]) + (\lp -> Option ("-L" ++ lp) + : if gopt Opt_RPath dflags + then [ Option "-Xlinker" + , Option "-rpath" + , Option "-Xlinker" + , Option lp ] + else []) minus_big_ls -- See Note [-Xlinker -rpath vs -Wl,-rpath] ++ map (\l -> Option ("-l" ++ l)) minus_ls, ===================================== compiler/main/DriverPipeline.hs ===================================== @@ -382,7 +382,56 @@ compileEmptyStub dflags hsc_env basename location mod_name = do -- --------------------------------------------------------------------------- -- Link - +-- +-- Note [Dynamic linking on macOS] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- Since macOS Sierra (10.14), the dynamic system linker enforces +-- a limit on the Load Commands. Specifically the Load Command Size +-- Limit is at 32K (32768). The Load Commands contain the install +-- name, dependencies, runpaths, and a few other commands. We however +-- only have control over the install name, dependencies and runpaths. +-- +-- The install name is the name by which this library will be +-- referenced. This is such that we do not need to bake in the full +-- absolute location of the library, and can move the library around. +-- +-- The dependency commands contain the install names from of referenced +-- libraries. Thus if a libraries install name is @rpath/libHS...dylib, +-- that will end up as the dependency. +-- +-- Finally we have the runpaths, which informs the linker about the +-- directories to search for the referenced dependencies. +-- +-- The system linker can do recursive linking, however using only the +-- direct dependencies conflicts with ghc's ability to inline across +-- packages, and as such would end up with unresolved symbols. +-- +-- Thus we will pass the full dependency closure to the linker, and then +-- ask the linker to remove any unused dynamic libraries (-dead_strip_dylibs). +-- +-- We still need to add the relevant runpaths, for the dynamic linker to +-- lookup the referenced libraries though. The linker (ld64) does not +-- have any option to dead strip runpaths; which makes sense as runpaths +-- can be used for dependencies of dependencies as well. +-- +-- The solution we then take in GHC is to not pass any runpaths to the +-- linker at link time, but inject them after the linking. For this to +-- work we'll need to ask the linker to create enough space in the header +-- to add more runpaths after the linking (-headerpad 8000). +-- +-- After the library has been linked by $LD (usually ld64), we will use +-- otool to inspect the libraries left over after dead stripping, compute +-- the relevant runpaths, and inject them into the linked product using +-- the install_name_tool command. +-- +-- This strategy should produce the smallest possible set of load commands +-- while still retaining some form of relocatability via runpaths. +-- +-- The only way I can see to reduce the load command size further would be +-- by shortening the library names, or start putting libraries into the same +-- folders, such that one runpath would be sufficient for multiple/all +-- libraries. link :: GhcLink -- interactive or batch -> DynFlags -- dynamic flags -> Bool -- attempt linking in batch mode? @@ -1769,9 +1818,12 @@ linkBinary' staticLink dflags o_files dep_packages = do rc_objs <- maybeCreateManifest dflags output_fn - let link = if staticLink - then SysTools.runLibtool - else SysTools.runLink + let link dflags args | staticLink = SysTools.runLibtool dflags args + | platformOS platform == OSDarwin + = SysTools.runLink dflags args >> SysTools.runInjectRPaths dflags pkg_lib_paths output_fn + | otherwise + = SysTools.runLink dflags args + link dflags ( map SysTools.Option verbFlags ++ [ SysTools.Option "-o" @@ -1838,7 +1890,13 @@ linkBinary' staticLink dflags o_files dep_packages = do ++ pkg_link_opts ++ pkg_framework_opts ++ (if platformOS platform == OSDarwin - then [ "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the left over + -- libraries during runInjectRpaths phase. + -- + -- See Note [Dynamic linking on macOS]. + then [ "-Wl,-dead_strip_dylibs", "-Wl,-headerpad,8000" ] else []) )) ===================================== compiler/main/DynFlags.hs ===================================== @@ -155,8 +155,8 @@ module DynFlags ( versionedAppDir, versionedFilePath, extraGccViaCFlags, systemPackageConfig, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T, - pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc, - pgm_lcc, pgm_i, + pgm_windres, pgm_libtool, pgm_ar, pgm_otool, pgm_install_name_tool, + pgm_ranlib, pgm_lo, pgm_lc, pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_cxx, opt_a, opt_l, opt_lm, opt_i, opt_P_signature, opt_windres, opt_lo, opt_lc, opt_lcc, @@ -1463,6 +1463,10 @@ pgm_lcc :: DynFlags -> (String,[Option]) pgm_lcc dflags = toolSettings_pgm_lcc $ toolSettings dflags pgm_ar :: DynFlags -> String pgm_ar dflags = toolSettings_pgm_ar $ toolSettings dflags +pgm_otool :: DynFlags -> String +pgm_otool dflags = toolSettings_pgm_otool $ toolSettings dflags +pgm_install_name_tool :: DynFlags -> String +pgm_install_name_tool dflags = toolSettings_pgm_install_name_tool $ toolSettings dflags pgm_ranlib :: DynFlags -> String pgm_ranlib dflags = toolSettings_pgm_ranlib $ toolSettings dflags pgm_lo :: DynFlags -> (String,[Option]) @@ -3089,6 +3093,10 @@ dynamic_flags_deps = [ $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_libtool = f } , make_ord_flag defFlag "pgmar" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ar = f } + , make_ord_flag defFlag "pgmotool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_otool = f} + , make_ord_flag defFlag "pgminstall_name_tool" + $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_install_name_tool = f} , make_ord_flag defFlag "pgmranlib" $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_ranlib = f } @@ -4589,7 +4597,6 @@ defaultFlags settings Opt_OmitYields, Opt_PrintBindContents, Opt_ProfCountEntries, - Opt_RPath, Opt_SharedImplib, Opt_SimplPreInlining, Opt_VersionMacros @@ -4600,6 +4607,8 @@ defaultFlags settings ++ default_PIC platform + ++ default_RPath platform + ++ concatMap (wayGeneralFlags platform) (defaultWays settings) ++ validHoleFitDefaults @@ -4640,6 +4649,29 @@ default_PIC platform = -- information. _ -> [] + +-- We usually want to use RPath, except on macOS (OSDarwin). On recent macOS +-- versions the number of load commands we can embed in a dynamic library is +-- restricted. Hence since b592bd98ff2 we rely on -dead_strip_dylib to only +-- link the needed dylibs instead of linking the full dependency closure. +-- +-- If we split the library linking into injecting -rpath and -l @rpath/... +-- components, we will reduce the number of libraries we link, however we will +-- still inject one -rpath entry for each library, independent of their use. +-- That is, we even inject -rpath values for libraries that we dead_strip in +-- the end. As such we can run afoul of the load command size limit simply +-- by polluting the load commands with RPATH entries. +-- +-- Thus, we disable Opt_RPath by default on OSDarwin. The savvy user can always +-- enable it with -use-rpath if they so wish. +-- +-- See Note [Dynamic linking on macOS] + +default_RPath :: Platform -> [GeneralFlag] +default_RPath platform | platformOS platform == OSDarwin = [] +default_RPath _ = [Opt_RPath] + + -- General flags that are switched on/off when other general flags are switched -- on impliedGFlags :: [(GeneralFlag, TurnOnFlag, GeneralFlag)] ===================================== compiler/main/Settings.hs ===================================== @@ -25,6 +25,8 @@ module Settings , sPgm_windres , sPgm_libtool , sPgm_ar + , sPgm_otool + , sPgm_install_name_tool , sPgm_ranlib , sPgm_lo , sPgm_lc @@ -139,6 +141,10 @@ sPgm_libtool :: Settings -> String sPgm_libtool = toolSettings_pgm_libtool . sToolSettings sPgm_ar :: Settings -> String sPgm_ar = toolSettings_pgm_ar . sToolSettings +sPgm_otool :: Settings -> String +sPgm_otool = toolSettings_pgm_otool . sToolSettings +sPgm_install_name_tool :: Settings -> String +sPgm_install_name_tool = toolSettings_pgm_install_name_tool . sToolSettings sPgm_ranlib :: Settings -> String sPgm_ranlib = toolSettings_pgm_ranlib . sToolSettings sPgm_lo :: Settings -> (String, [Option]) ===================================== compiler/main/SysTools.hs ===================================== @@ -254,7 +254,10 @@ linkDynLib dflags0 o_files dep_packages | ( osElfTarget (platformOS (targetPlatform dflags)) || osMachOTarget (platformOS (targetPlatform dflags)) ) && dynLibLoader dflags == SystemDependent && - WayDyn `elem` ways dflags + -- Only if we want dynamic libraries + WayDyn `elem` ways dflags && + -- Only use RPath if we explicitly asked for it + gopt Opt_RPath dflags = ["-L" ++ l, "-Xlinker", "-rpath", "-Xlinker", l] -- See Note [-Xlinker -rpath vs -Wl,-rpath] | otherwise = ["-L" ++ l] @@ -377,8 +380,15 @@ linkDynLib dflags0 o_files dep_packages ++ map Option pkg_lib_path_opts ++ map Option pkg_link_opts ++ map Option pkg_framework_opts - ++ [ Option "-Wl,-dead_strip_dylibs" ] + -- dead_strip_dylibs, will remove unused dylibs, and thus save + -- space in the load commands. The -headerpad is necessary so + -- that we can inject more @rpath's later for the leftover + -- libraries in the runInjectRpaths phase below. + -- + -- See Note [Dynamic linking on macOS] + ++ [ Option "-Wl,-dead_strip_dylibs", Option "-Wl,-headerpad,8000" ] ) + runInjectRPaths dflags pkg_lib_paths output_fn _ -> do ------------------------------------------------------------------- -- Making a DSO ===================================== compiler/main/SysTools/Settings.hs ===================================== @@ -119,6 +119,8 @@ initSettings top_dir = do windres_path <- getToolSetting "windres command" libtool_path <- getToolSetting "libtool command" ar_path <- getToolSetting "ar command" + otool_path <- getToolSetting "otool command" + install_name_tool_path <- getToolSetting "install_name_tool command" ranlib_path <- getToolSetting "ranlib command" -- TODO this side-effect doesn't belong here. Reading and parsing the settings @@ -210,6 +212,8 @@ initSettings top_dir = do , toolSettings_pgm_windres = windres_path , toolSettings_pgm_libtool = libtool_path , toolSettings_pgm_ar = ar_path + , toolSettings_pgm_otool = otool_path + , toolSettings_pgm_install_name_tool = install_name_tool_path , toolSettings_pgm_ranlib = ranlib_path , toolSettings_pgm_lo = (lo_prog,[]) , toolSettings_pgm_lc = (lc_prog,[]) ===================================== compiler/main/SysTools/Tasks.hs ===================================== @@ -28,6 +28,10 @@ import LlvmCodeGen.Base (LlvmVersion, llvmVersionStr, supportedLlvmVersion, pars import SysTools.Process import SysTools.Info +import Control.Monad (join, forM, filterM) +import System.Directory (doesFileExist) +import System.FilePath (()) + {- ************************************************************************ * * @@ -237,6 +241,41 @@ figureLlvmVersion dflags = traceToolCommand dflags "llc" $ do return Nothing) +-- | On macOS we rely on the linkers @-dead_strip_dylibs@ flag to remove unused +-- libraries from the dynamic library. We do this to reduce the number of load +-- commands that end up in the dylib, and has been limited to 32K (32768) since +-- macOS Sierra (10.14). +-- +-- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing +-- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not +-- being included in the load commands, however the @-rpath@ entries are all +-- forced to be included. This can lead to 100s of @-rpath@ entries being +-- included when only a handful of libraries end up being truely linked. +-- +-- Thus after building the library, we run a fixup phase where we inject the +-- @-rpath@ for each found library (in the given library search paths) into the +-- dynamic library through @-add_rpath at . +-- +-- See Note [Dynamic linking on macOS] +runInjectRPaths :: DynFlags -> [FilePath] -> FilePath -> IO () +runInjectRPaths dflags lib_paths dylib = do + info <- lines <$> askOtool dflags Nothing [Option "-L", Option dylib] + -- filter the output for only the libraries. And then drop the @rpath prefix. + let libs = fmap (drop 7) $ filter (isPrefixOf "@rpath") $ fmap (head.words) $ info + -- find any pre-existing LC_PATH items + info <- fmap words.lines <$> askOtool dflags Nothing [Option "-l", Option dylib] + let paths = concatMap f info + where f ("path":p:_) = [p] + f _ = [] + lib_paths' = [ p | p <- lib_paths, not (p `elem` paths) ] + -- only find those rpaths, that aren't already in the library. + rpaths <- nub.sort.join <$> forM libs (\f -> filterM (\l -> doesFileExist (l f)) lib_paths') + -- inject the rpaths + case rpaths of + [] -> return () + _ -> runInstallNameTool dflags $ map Option $ "-add_rpath":(intersperse "-add_rpath" rpaths) ++ [dylib] + + runLink :: DynFlags -> [Option] -> IO () runLink dflags args = traceToolCommand dflags "linker" $ do -- See Note [Run-time linker info] @@ -335,6 +374,17 @@ askAr dflags mb_cwd args = traceToolCommand dflags "ar" $ do runSomethingWith dflags "Ar" ar args $ \real_args -> readCreateProcessWithExitCode' (proc ar real_args){ cwd = mb_cwd } +askOtool :: DynFlags -> Maybe FilePath -> [Option] -> IO String +askOtool dflags mb_cwd args = do + let otool = pgm_otool dflags + runSomethingWith dflags "otool" otool args $ \real_args -> + readCreateProcessWithExitCode' (proc otool real_args){ cwd = mb_cwd } + +runInstallNameTool :: DynFlags -> [Option] -> IO () +runInstallNameTool dflags args = do + let tool = pgm_install_name_tool dflags + runSomethingFiltered dflags id "Install Name Tool" tool args Nothing Nothing + runRanlib :: DynFlags -> [Option] -> IO () runRanlib dflags args = traceToolCommand dflags "ranlib" $ do let ranlib = pgm_ranlib dflags ===================================== compiler/main/ToolSettings.hs ===================================== @@ -31,6 +31,8 @@ data ToolSettings = ToolSettings , toolSettings_pgm_windres :: String , toolSettings_pgm_libtool :: String , toolSettings_pgm_ar :: String + , toolSettings_pgm_otool :: String + , toolSettings_pgm_install_name_tool :: String , toolSettings_pgm_ranlib :: String , -- | LLVM: opt llvm optimiser toolSettings_pgm_lo :: (String, [Option]) ===================================== configure.ac ===================================== @@ -669,6 +669,18 @@ else fi AC_SUBST([LibtoolCmd]) +dnl ** Which otool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([OTOOL], [otool]) +OtoolCmd="$OTOOL" +AC_SUBST(OtoolCmd) + +dnl ** Which install_name_tool to use on macOS +dnl -------------------------------------------------------------- +AC_CHECK_TARGET_TOOL([INSTALL_NAME_TOOL], [install_name_tool]) +InstallNameToolCmd="$INSTALL_NAME_TOOL" +AC_SUBST(InstallNameToolCmd) + # Here is where we re-target which specific version of the LLVM # tools we are looking for. In the past, GHC supported a number of # versions of LLVM simultaneously, but that stopped working around @@ -1479,6 +1491,8 @@ echo "\ libtool : $LibtoolCmd objdump : $ObjdumpCmd ranlib : $RanlibCmd + otool : $OtoolCmd + install_name_tool : $InstallNameToolCmd windres : $WindresCmd dllwrap : $DllWrapCmd genlib : $GenlibCmd ===================================== docs/users_guide/phases.rst ===================================== @@ -95,6 +95,24 @@ given compilation phase: Use ⟨cmd⟩ as the pre-processor (with :ghc-flag:`-F` only). +.. ghc-flag:: -pgmotool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inspect mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inspect mach-o dynamic libraries and + executables to read the dynamic library dependencies. We will compute + the necessary ``runpath``s to embed for the dependencies based on the + result of the ``otool`` call. + +.. ghc-flag:: -pgminstall_name_tool ⟨cmd⟩ + :shortdesc: Use ⟨cmd⟩ as the program to inject ``runpath`` into mach-o dylibs on macOS + :type: dynamic + :category: phase-programs + + Use ⟨cmd⟩ as the program to inject ``runpath``s into mach-o dynamic + libraries and executables. As detected by the ``otool`` call. + .. ghc-flag:: -pgmwindres ⟨cmd⟩ :shortdesc: Use ⟨cmd⟩ as the program for embedding manifests on Windows. :type: dynamic ===================================== hadrian/cfg/system.config.in ===================================== @@ -147,6 +147,8 @@ settings-merge-objects-command = @SettingsMergeObjectsCommand@ settings-merge-objects-flags = @SettingsMergeObjectsFlags@ settings-ar-command = @SettingsArCommand@ settings-ranlib-command = @SettingsRanlibCommand@ +settings-otool-command = @SettingsOtoolCommand@ +settings-install_name_tool-command = @SettingsInstallNameToolCommand@ settings-dll-wrap-command = @SettingsDllWrapCommand@ settings-windres-command = @SettingsWindresCommand@ settings-libtool-command = @SettingsLibtoolCommand@ ===================================== hadrian/src/Oracles/Setting.hs ===================================== @@ -113,6 +113,8 @@ data SettingsFileSetting | SettingsFileSetting_MergeObjectsFlags | SettingsFileSetting_ArCommand | SettingsFileSetting_RanlibCommand + | SettingsFileSetting_OtoolCommand + | SettingsFileSetting_InstallNameToolCommand | SettingsFileSetting_DllWrapCommand | SettingsFileSetting_WindresCommand | SettingsFileSetting_LibtoolCommand @@ -198,6 +200,8 @@ settingsFileSetting key = lookupValueOrError configFile $ case key of SettingsFileSetting_MergeObjectsFlags -> "settings-merge-objects-flags" SettingsFileSetting_ArCommand -> "settings-ar-command" SettingsFileSetting_RanlibCommand -> "settings-ranlib-command" + SettingsFileSetting_OtoolCommand -> "settings-otool-command" + SettingsFileSetting_InstallNameToolCommand -> "settings-install_name_tool-command" SettingsFileSetting_DllWrapCommand -> "settings-dll-wrap-command" SettingsFileSetting_WindresCommand -> "settings-windres-command" SettingsFileSetting_LibtoolCommand -> "settings-libtool-command" ===================================== hadrian/src/Rules/Generate.hs ===================================== @@ -294,6 +294,8 @@ generateSettings = do , ("ar flags", expr $ lookupValueOrError configFile "ar-args") , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile) , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand) + , ("otool command", expr $ settingsFileSetting SettingsFileSetting_OtoolCommand) + , ("install_name_tool command", expr $ settingsFileSetting SettingsFileSetting_InstallNameToolCommand) , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand) , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand) , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand) ===================================== includes/ghc.mk ===================================== @@ -228,6 +228,8 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/. @echo ',("ar flags", "$(ArArgs)")' >> $@ @echo ',("ar supports at file", "$(ArSupportsAtFile)")' >> $@ @echo ',("ranlib command", "$(SettingsRanlibCommand)")' >> $@ + @echo ',("otool command", "$(SettingsOtoolCommand)")' >> $@ + @echo ',("install_name_tool command", "$(SettingsInstallNameToolCommand)")' >> $@ @echo ',("touch command", "$(SettingsTouchCommand)")' >> $@ @echo ',("dllwrap command", "$(SettingsDllWrapCommand)")' >> $@ @echo ',("windres command", "$(SettingsWindresCommand)")' >> $@ ===================================== mk/config.mk.in ===================================== @@ -515,6 +515,8 @@ SettingsLdFlags = @SettingsLdFlags@ SettingsMergeObjectsCommand = @SettingsMergeObjectsCommand@ SettingsMergeObjectsFlags = @SettingsMergeObjectsFlags@ SettingsArCommand = @SettingsArCommand@ +SettingsOtoolCommand = @SettingsOtoolCommand@ +SettingsInstallNameToolCommand = @SettingsInstallNameToolCommand@ SettingsRanlibCommand = @SettingsRanlibCommand@ SettingsDllWrapCommand = @SettingsDllWrapCommand@ SettingsWindresCommand = @SettingsWindresCommand@ ===================================== testsuite/tests/rts/all.T ===================================== @@ -403,7 +403,7 @@ test('T16514', unless(opsys('mingw32'), skip), compile_and_run, ['T16514_c.cpp - test('test-zeroongc', extra_run_opts('-DZ'), compile_and_run, ['-debug']) test('T13676', - [when(opsys('darwin') or opsys('mingw32'), expect_broken(17447)), + [when(opsys('mingw32'), expect_broken(17447)), extra_files(['T13676.hs'])], ghci_script, ['T13676.script']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffc00acc68776385e2736e613b2571ad89ae60b0 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffc00acc68776385e2736e613b2571ad89ae60b0 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 06:02:47 2020 From: gitlab at gitlab.haskell.org (Sven Tennie) Date: Fri, 11 Sep 2020 02:02:47 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] Apply suggestion to testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c Message-ID: <5f5b13075df63_80b3f848bd5b73c115182b0@gitlab.haskell.org.mail> Sven Tennie pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: 7a89b21e by Sven Tennie at 2020-09-11T02:02:46-04:00 Apply suggestion to testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c - - - - - 1 changed file: - testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c Changes: ===================================== testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c ===================================== @@ -22,7 +22,11 @@ void* pauseAndUnpause_thread(void* unused){ timestamps.end = time(NULL); rts_unpause(r_paused); - + + if(rts_isPaused()) { + errorBelch("Expected the RTS to be unpaused."); + exit(1); + } return NULL; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a89b21e6ebbf4b92d81e6675bc43ee07d5f9e44 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7a89b21e6ebbf4b92d81e6675bc43ee07d5f9e44 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 06:10:04 2020 From: gitlab at gitlab.haskell.org (Moritz Angermann) Date: Fri, 11 Sep 2020 02:10:04 -0400 Subject: [Git][ghc/ghc][wip/angerman/aarch64-ncg] :broom: :dash: Message-ID: <5f5b14bcd7ae9_80b3f84866e5ab011522527@gitlab.haskell.org.mail> Moritz Angermann pushed to branch wip/angerman/aarch64-ncg at Glasgow Haskell Compiler / GHC Commits: eb3db893 by Moritz Angermann at 2020-09-11T06:09:53+00:00 :broom: :dash: - - - - - 7 changed files: - compiler/GHC/CmmToAsm/AArch64/CodeGen.hs - compiler/GHC/CmmToAsm/AArch64/Cond.hs - compiler/GHC/CmmToAsm/AArch64/Instr.hs - compiler/GHC/CmmToAsm/AArch64/Ppr.hs - compiler/GHC/CmmToAsm/AArch64/RegInfo.hs - compiler/GHC/CmmToAsm/PIC.hs - compiler/GHC/CmmToAsm/Reg/Liveness.hs Changes: ===================================== compiler/GHC/CmmToAsm/AArch64/CodeGen.hs ===================================== @@ -18,15 +18,12 @@ import GHC.Prelude hiding (EQ) import GHC.Platform.Regs import GHC.CmmToAsm.AArch64.Instr import GHC.CmmToAsm.AArch64.Regs -import GHC.CmmToAsm.AArch64.RegInfo import GHC.CmmToAsm.AArch64.Cond -import GHC.CmmToAsm.AArch64.Ppr import GHC.CmmToAsm.CPrim import GHC.Cmm.DebugBlock import GHC.CmmToAsm.Monad - ( NatM, getNewRegNat, getNewLabelNat - , getBlockIdNat, getPicBaseNat, getNewRegPairNat + ( NatM, getNewRegNat , getPicBaseMaybeNat, getPlatform, getConfig , getDebugBlock, getFileId ) @@ -34,14 +31,11 @@ import GHC.CmmToAsm.Instr import GHC.CmmToAsm.PIC import GHC.CmmToAsm.Format import GHC.CmmToAsm.Config --- import GHC.Platform.Reg.Class import GHC.Platform.Reg --- import GHC.CmmToAsm.Reg.Target import GHC.Platform -- Our intermediate code: import GHC.Cmm.BlockId --- import GHC.Cmm.Ppr ( pprExpr ) import GHC.Cmm import GHC.Cmm.Utils import GHC.Cmm.Switch @@ -59,7 +53,6 @@ import Control.Monad ( mapAndUnzipM, when, foldM ) import Data.Bits import Data.Word import Data.Maybe --- import Data.Int import GHC.Float import GHC.Types.Basic @@ -67,8 +60,6 @@ import GHC.Types.ForeignCall import GHC.Data.FastString import GHC.Utils.Misc --- import Debug.Trace - -- @cmmTopCodeGen@ will be our main entry point to code gen. Here we'll get -- @RawCmmDecl@; see GHC.Cmm -- ===================================== compiler/GHC/CmmToAsm/AArch64/Cond.hs ===================================== @@ -2,8 +2,6 @@ module GHC.CmmToAsm.AArch64.Cond where import GHC.Prelude -import GHC.Utils.Panic - -- https://developer.arm.com/documentation/den0024/a/the-a64-instruction-set/data-processing-instructions/conditional-instructions -- XXX: This appears to go a bit overboard? Maybe we should stick with what LLVM ===================================== compiler/GHC/CmmToAsm/AArch64/Instr.hs ===================================== @@ -99,7 +99,6 @@ aarch64_regUsageOfInstr platform instr = case instr of ANN _ i -> aarch64_regUsageOfInstr platform i -- 1. Arithmetic Instructions ------------------------------------------------ ADD dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) - ADDS dst src1 src2 -> usage (regOp src1 ++ regOp src2, regOp dst) CMN l r -> usage (regOp l ++ regOp r, []) CMP l r -> usage (regOp l ++ regOp r, []) MSUB dst src1 src2 src3 -> usage (regOp src1 ++ regOp src2 ++ regOp src3, regOp dst) @@ -223,7 +222,6 @@ aarch64_patchRegsOfInstr instr env = case instr of ANN d i -> ANN d (aarch64_patchRegsOfInstr i env) -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) - ADDS o1 o2 o3 -> ADDS (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) CMP o1 o2 -> CMP (patchOp o1) (patchOp o2) MSUB o1 o2 o3 o4 -> MSUB (patchOp o1) (patchOp o2) (patchOp o3) (patchOp o4) @@ -555,7 +553,7 @@ data Instr -- | ADC Operand Operand Operang -- rd = rn + rm + C -- | ADCS ... | ADD Operand Operand Operand -- rd = rn + rm - | ADDS Operand Operand Operand -- rd = rn + rm + -- | ADDS Operand Operand Operand -- rd = rn + rm -- | ADR ... -- | ADRP ... | CMN Operand Operand -- rd + op2 ===================================== compiler/GHC/CmmToAsm/AArch64/Ppr.hs ===================================== @@ -2,8 +2,6 @@ module GHC.CmmToAsm.AArch64.Ppr (pprNatCmmDecl) where import GHC.Prelude hiding (EQ) -import Data.List (findIndex, all) - import GHC.CmmToAsm.AArch64.Instr import GHC.CmmToAsm.AArch64.Regs import GHC.CmmToAsm.AArch64.Cond @@ -11,8 +9,6 @@ import GHC.CmmToAsm.Ppr import GHC.CmmToAsm.Instr import GHC.CmmToAsm.Format import GHC.Platform.Reg -import GHC.Platform.Reg.Class -import GHC.CmmToAsm.Reg.Target import GHC.CmmToAsm.Config import GHC.Cmm hiding (topInfoTable) @@ -72,8 +68,6 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) = else empty) $$ pprSizeDecl platform info_lbl -pprNatCmmDecl _ _ = undefined - pprLabel :: Platform -> CLabel -> SDoc pprLabel platform lbl = pprGloblDecl lbl @@ -81,7 +75,7 @@ pprLabel platform lbl = $$ (ppr lbl <> char ':') pprAlign :: Platform -> Alignment -> SDoc -pprAlign platform alignment +pprAlign _platform alignment = text "\t.balign " <> int (alignmentBytes alignment) -- | Print appropriate alignment for the given section type. @@ -141,6 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) -- See https://gitlab.haskell.org/ghc/ghc/-/issues/367 -- This only intends to catch the very trivial case, not the more -- compilicated cases. + {- detectTrivialDeadlock :: [Instr] -> [Instr] detectTrivialDeadlock instrs = case (findIndex isSelfBranch instrs) of Just n | all (not . aarch64_isJumpishInstr) (take n instrs) -> @@ -157,6 +152,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs) where isSelfBranch (B (TBlock blockid')) = blockid' == blockid isSelfBranch _ = False + -} asmLbl = blockLbl blockid platform = ncgPlatform config @@ -254,6 +250,8 @@ pprDataItem config lit = let bs = doubleToBytes (fromRational r) in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs + ppr_item _ _ = pprPanic "pprDataItem:ppr_item" (text $ show lit) + pprImm :: Imm -> SDoc pprImm (ImmInt i) = int i @@ -339,7 +337,6 @@ pprOp op = case op of OpAddr (AddrRegReg r1 r2) -> char '[' <+> pprReg W64 r1 <> comma <+> pprReg W64 r2 <+> char ']' OpAddr (AddrRegImm r1 im) -> char '[' <+> pprReg W64 r1 <> comma <+> pprImm im <+> char ']' OpAddr (AddrReg r1) -> char '[' <+> pprReg W64 r1 <+> char ']' - OpAddr _ -> panic "AArch64.pprOp: no amode" pprReg :: Width -> Reg -> SDoc pprReg w r = case r of @@ -349,6 +346,7 @@ pprReg w r = case r of RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUniqueAlways u RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUniqueAlways u RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUniqueAlways u + _ -> pprPanic "AArch64.pprReg" (text $ show r) where ppr_reg_no :: Width -> Int -> SDoc @@ -459,7 +457,7 @@ pprInstr platform instr = case instr of BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> ppr (mkLocalBlockLabel (getUnique bid)) BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> ppr lbl - BCOND c (TReg r) -> panic "AArch64.ppr: No conditional branching to registers!" + BCOND _ (TReg _) -> panic "AArch64.ppr: No conditional branching to registers!" -- 5. Atomic Instructions ---------------------------------------------------- -- 6. Conditional Instructions ----------------------------------------------- @@ -467,11 +465,11 @@ pprInstr platform instr = case instr of CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp o <> comma <+> ppr (mkLocalBlockLabel (getUnique bid)) CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp o <> comma <+> ppr lbl - CBZ c (TReg r) -> panic "AArch64.ppr: No conditional (cbz) branching to registers!" + CBZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbz) branching to registers!" CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp o <> comma <+> ppr (mkLocalBlockLabel (getUnique bid)) CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp o <> comma <+> ppr lbl - CBNZ c (TReg r) -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!" + CBNZ _ (TReg _) -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!" -- 7. Load and Store Instructions -------------------------------------------- -- NOTE: GHC may do whacky things where it only load the lower part of an @@ -544,4 +542,10 @@ pprCond c = case c of OLT -> text "mi" OLE -> text "ls" OGE -> text "ge" - OGT -> text "gt" \ No newline at end of file + OGT -> text "gt" + + -- Unordered + UOLT -> text "lt" + UOLE -> text "le" + UOGE -> text "pl" + UOGT -> text "hi" \ No newline at end of file ===================================== compiler/GHC/CmmToAsm/AArch64/RegInfo.hs ===================================== @@ -5,17 +5,10 @@ module GHC.CmmToAsm.AArch64.RegInfo where import GHC.Prelude -import GHC.Platform.Reg -import GHC.Platform.Reg.Class -import GHC.CmmToAsm.Format - import GHC.CmmToAsm.AArch64.Instr - import GHC.Cmm.BlockId import GHC.Cmm -import GHC.Cmm.CLabel -import GHC.Types.Unique import GHC.Utils.Outputable data JumpDest = DestBlockId BlockId ===================================== compiler/GHC/CmmToAsm/PIC.hs ===================================== @@ -268,7 +268,7 @@ howToAccessLabel config _ OSMinGW32 this_mod _ lbl -- is enough for ~64MB of range. Anything else will need to go through a veneer, -- which is the job of the linker to build. We might only want to lookup -- Data References through the GOT. -howToAccessLabel config ArchAArch64 _os this_mod kind lbl +howToAccessLabel config ArchAArch64 _os this_mod _kind lbl | not (ncgExternalDynamicRefs config) = AccessDirectly ===================================== compiler/GHC/CmmToAsm/Reg/Liveness.hs ===================================== @@ -154,6 +154,8 @@ instance Instruction instr => Instruction (InstrSR instr) where mkStackDeallocInstr platform amount = Instr <$> mkStackDeallocInstr platform amount + mkComment = fmap Instr . mkComment + -- | An instruction with liveness information. data LiveInstr instr View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb3db8938347b148a4b5dd7b3d1fbf1282d12a21 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eb3db8938347b148a4b5dd7b3d1fbf1282d12a21 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 06:20:52 2020 From: gitlab at gitlab.haskell.org (Sven Tennie) Date: Fri, 11 Sep 2020 02:20:52 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] 87 commits: Add missing primop documentation (#18454) Message-ID: <5f5b17445b642_80b3f848bbc0bd4115238d2@gitlab.haskell.org.mail> Sven Tennie pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: c6f50cea by Krzysztof Gogolewski at 2020-08-28T02:22:36-04:00 Add missing primop documentation (#18454) - Add three pseudoops to primops.txt.pp, so that Haddock renders the documentation - Update comments - Remove special case for "->" - it's no longer exported from GHC.Prim - Remove reference to Note [Compiling GHC.Prim] - the ad-hoc fix is no longer there after updates to levity polymorphism. - Document GHC.Prim - Remove the comment that lazy is levity-polymorphic. As far as I can tell, it never was: in 80e399639, only the unfolding was given an open type variable. - Remove haddock hack in GHC.Magic - no longer neccessary after adding realWorld# to primops.txt.pp. - - - - - f065b6b0 by Tamar Christina at 2020-08-28T02:23:13-04:00 Fix use distro toolchian - - - - - 4517a382 by Tamar Christina at 2020-08-28T02:23:13-04:00 document how build system find toolchains on Windows - - - - - 329f7cb9 by Ben Gamari at 2020-08-31T22:59:14-04:00 base: Better error message on invalid getSystemTimerManager call Previously we would produce a rather unhelpful pattern match failure error in the case where the user called `getSystemTimerManager` in a program which isn't built with `-threaded`. This understandably confused the user in #15616. Fixes #15616. - - - - - f6d70a8f by Roland Senn at 2020-08-31T22:59:50-04:00 Add tests for #15617. Avoid a similar regression in the future. - - - - - e5969fd0 by Roland Senn at 2020-08-31T23:00:27-04:00 Add additional tests for #18172 (Followup MR 3543) There was still one active discussion [thread](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3543#note_284325) when MR !3543 got merged. This MR adds the requested tests exercising the changes in `compiler/GHC/HsToCore/Match/Literal.hs:warnAboutEmptyEnumerations` and its sub-functions. - - - - - fe18b482 by Ben Gamari at 2020-08-31T23:01:02-04:00 Bump Win32 and process submodules - - - - - 2da93308 by Sylvain Henry at 2020-08-31T23:01:39-04:00 Hadrian: fix slow-validate flavour (#18586) - - - - - 85e13008 by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Update dominator code with fixes from the dom-lt package. Two bugs turned out in the package that have been fixed since. This MR includes this fixes in the GHC port of the code. - - - - - dffb38fa by Andreas Klebinger at 2020-08-31T23:02:15-04:00 Dominators.hs: Use unix line endings - - - - - 6189cc04 by Moritz Angermann at 2020-08-31T23:02:50-04:00 [fixup 3433] move debugBelch into IF_DEBUG(linker) The commit in dff1cb3d9c111808fec60190747272b973547c52 incorrectly left the `debugBelch` function without a comment or IF_DEBUG(linker,) decoration. This rectifies it. Needs at least a 8.10 backport, as it was backported in 6471cc6aff80d5deebbdb1bf7b677b31ed2af3d5 - - - - - bcb68a3f by Sylvain Henry at 2020-08-31T23:03:27-04:00 Don't store HomeUnit in UnitConfig Allow the creation of a UnitConfig (hence of a UnitState) without having a HomeUnit. It's required for #14335. - - - - - 0a372387 by Sylvain Henry at 2020-08-31T23:04:04-04:00 Fix documentation and fix "check" bignum backend (#18604) - - - - - eb85f125 by Moritz Angermann at 2020-08-31T23:04:39-04:00 Set the dynamic-system-linker flag to Manual This flag should be user controllable, hence Manual: True. - - - - - 380ef845 by Sven Tennie at 2020-08-31T23:05:14-04:00 Ignore more files Ignore files from "new style" cabal builds (dist-newstyle folders) and from clangd (C language server). - - - - - 74a7fbff by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.0 and earlier (#18620) This patch adds the upper bound of a happy version for ghc-9.0 and earlier. Currently, we can't use happy-1.20.0 for ghc-9.0. See #18620. - - - - - a4473f02 by Takenobu Tani at 2020-08-31T23:05:51-04:00 Limit upper version of Happy for ghc-9.2 (#18620) This patch adds the upper bound of a happy version for ghc-9.2. Currently, We can use happy-1.19 or happy-1.20 for ghc-9.2. See #18620. - - - - - a8a2568b by Sylvain Henry at 2020-08-31T23:06:28-04:00 Bignum: add BigNat compat functions (#18613) - - - - - 884245dd by Sylvain Henry at 2020-09-01T12:39:36-04:00 Fix FastString lexicographic ordering (fix #18562) - - - - - 4b4fbc58 by Sylvain Henry at 2020-09-01T12:39:36-04:00 Remove "Ord FastString" instance FastStrings can be compared in 2 ways: by Unique or lexically. We don't want to bless one particular way with an "Ord" instance because it leads to bugs (#18562) or to suboptimal code (e.g. using lexical comparison while a Unique comparison would suffice). UTF-8 encoding has the advantage that sorting strings by their encoded bytes also sorts them by their Unicode code points, without having to decode the actual code points. BUT GHC uses Modified UTF-8 which diverges from UTF-8 by encoding \0 as 0xC080 instead of 0x00 (to avoid null bytes in the middle of a String so that the string can still be null-terminated). This patch adds a new `utf8CompareShortByteString` function that performs sorting by bytes but that also takes Modified UTF-8 into account. It is much more performant than decoding the strings into [Char] to perform comparisons (which we did in the previous patch). Bump haddock submodule - - - - - b4edcde7 by Ben Gamari at 2020-09-01T14:53:42-04:00 testsuite: Add broken test for #18302 - - - - - bfab2a30 by Sebastian Graf at 2020-09-02T15:54:55-04:00 Turn on -XMonoLocalBinds by default (#18430) And fix the resulting type errors. Co-authored-by: Krzysztof Gogolewski <krz.gogolewski at gmail.com> Metric Decrease: parsing001 - - - - - c30cc0e9 by David Feuer at 2020-09-02T15:55:31-04:00 Remove potential space leak from Data.List.transpose Previously, `transpose` produced a list of heads and a list of tails independently. This meant that a function using only some heads, and only some tails, could potentially leak space. Use `unzip` to work around the problem by producing pairs and selector thunks instead. Time and allocation behavior will be worse, but there should be no more leak potential. - - - - - ffc3da47 by Sylvain Henry at 2020-09-02T15:56:11-04:00 Remove outdated note - - - - - 85e62123 by Sylvain Henry at 2020-09-02T15:56:48-04:00 Bignum: add missing compat import/export functions - - - - - 397c2b03 by Ben Gamari at 2020-09-03T17:31:47-04:00 configure: Work around Raspbian's silly packaging decisions See #17856. - - - - - 4891c18a by Kathryn Spiers at 2020-09-03T17:32:24-04:00 expected-undocumented-flags remove kill flags It looks like the flags were removed in https://gitlab.haskell.org/ghc/ghc/-/commit/3e27205a66b06a4501d87eb31e285eadbc693eb7 and can safely be removed here - - - - - 1d6d6488 by Sylvain Henry at 2020-09-04T16:24:20-04:00 Don't rely on CLabel's Outputable instance in CmmToC This is in preparation of the removal of sdocWithDynFlags (#10143), hence of the refactoring of CLabel's Outputable instance. - - - - - 89ce7cdf by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: use Platform in foldRegs* - - - - - 220ad8d6 by Sylvain Henry at 2020-09-04T16:24:59-04:00 DynFlags: don't pass DynFlags to cmmImplementSwitchPlans - - - - - c1e54439 by Ryan Scott at 2020-09-04T16:25:35-04:00 Introduce isBoxedTupleDataCon and use it to fix #18644 The code that converts promoted tuple data constructors to `IfaceType`s in `GHC.CoreToIface` was using `isTupleDataCon`, which conflates boxed and unboxed tuple data constructors. To avoid this, this patch introduces `isBoxedTupleDataCon`, which is like `isTupleDataCon` but only works for _boxed_ tuple data constructors. While I was in town, I was horribly confused by the fact that there were separate functions named `isUnboxedTupleCon` and `isUnboxedTupleTyCon` (similarly, `isUnboxedSumCon` and `isUnboxedSumTyCon`). It turns out that the former only works for data constructors, despite its very general name! I opted to rename `isUnboxedTupleCon` to `isUnboxedTupleDataCon` (similarly, I renamed `isUnboxedSumCon` to `isUnboxedSumDataCon`) to avoid this potential confusion, as well as to be more consistent with the naming convention I used for `isBoxedTupleDataCon`. Fixes #18644. - - - - - 07bdcac3 by GHC GitLab CI at 2020-09-04T22:26:25-04:00 configure: Avoid hard-coded ld path on Windows The fix to #17962 ended up regressing on Windows as it failed to replicate the logic responsible for overriding the toolchain paths on Windows. This resulted in a hard-coded path to a directory that likely doesn't exist on the user's system (#18550). - - - - - 0be8e746 by Benjamin Maurer at 2020-09-04T22:27:01-04:00 Documented the as of yet undocumented '--print-*' GHC flags, as well as `-split-objs`, since that is related to `--print-object-splitting-supported`. See #18641 - - - - - 4813486f by Sylvain Henry at 2020-09-04T22:27:44-04:00 Move Hadrian's wiki pages in tree (fix #16165) Only the debugging page contains interesting stuff. Some of this stuff looks old (e.g. recommending "cabal install")... - - - - - 7980ae23 by GHC GitLab CI at 2020-09-05T14:50:52-04:00 rts: Consistently use stgMallocBytes instead of malloc This can help in debugging RTS memory leaks since all allocations go through the same interface. - - - - - 67059893 by Ben Gamari at 2020-09-05T14:51:27-04:00 configure: Fix whitespace - - - - - be2cc0ad by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: More intelligent detection of locale availability Previously ci.sh would unconditionally use C.UTF-8. However, this fails on Centos 7, which appears not to provide this locale. Now we first try C.UTF-8, then try en_US.UTF-8, then fail. Works around #18607. - - - - - 15dca847 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Rename RELEASE variable to RELEASE_JOB This interfered with the autoconf variable of the same name, breaking pre-release builds. - - - - - bec0d170 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Bump Windows toolchain version This should have been done when we bumped the bootstrap compiler to 8.8.4. - - - - - 9fbaee21 by Ben Gamari at 2020-09-05T14:51:27-04:00 gitlab-ci: Drop Windows make job These are a significant burden on our CI resources and end up failing quite often due to #18274. Here I drop the make jobs during validaion; it is now run only during the nightly builds. - - - - - 869f6e19 by Ben Gamari at 2020-09-05T14:51:27-04:00 testsuite: Drop Windows-specific output for parseTree The normalise_slashes normaliser should handle this. - - - - - 2c9f743c by Ben Gamari at 2020-09-05T14:51:28-04:00 testsuite: Mark T5975[ab] as broken on Windows Due to #7305. - - - - - 643785e3 by Ben Gamari at 2020-09-05T14:51:28-04:00 gitlab-ci: Fix typo A small typo in a rule regular expression. - - - - - c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 8a857027 by Matthew Pickering at 2020-09-11T08:17:15+02:00 rts: Implement ghc-debug API (#18405) There are four components to this patch which make it possible to implement `ghc-debug`. 1. Add four new functions to the RtsAPI. * rts_pause and rts_unpause allow an external process to completely pause and unpause the RTS. * rts_listThreads and rts_listMiscRoots are used to find the current roots of the garbage collector. These changes also mean that `Task.h` is exposed to the user. 2. Generalise the `ghc-heap` API so that raw `Word`s can be returned rather than actual objects. This is necessary when trying to decode closures on an external process because the pointers in such closures are correct for the internal rather than external process. If you used the previous API then you would get a segfault as the garbage collector would try to traverse into these nonsensical branches. ``` -- before getClosureData :: a -> IO Closure -- after getClosureDataX :: (forall c . c -> IO (Ptr StgInfoTable, [Word], [b])) -> a -> IO (GenClosure b) ``` For the normal case `b` is instantiated to `Box`, which contains a pointer to a heap object. ``` data Box = Box a -- GenClosure Box ``` For `ghc-debug` we instead just take the word of the address as we have to explicitly interpret it on the external process. ``` GenClosure Word ``` 3. Support for decoding `TSO` and `STACK` closures is partially implemented. There is still quite a bit of work to do to finish both but these at least allow us to make some more progress. 4. findPtr is generalised to take a callback argument. This means that its result can be communicated to the debugger rather than just printing out the result. The debugger has a function which invokes `findPtr` and passes a callback which sends the result over a socket. Co-authored-by: Ben Gamari <ben at smart-cactus.org> - - - - - 91b9a5b2 by Sven Tennie at 2020-09-11T08:17:15+02:00 Decode more StgTSO and StgStack fields (#18405) Use hsc2hs to get an understandable and stable mapping from the C structs to Haskell. It's important to keep StgTSO and StgStack decoding downwards compatible. This is especially needed for hadrian/ghci. - - - - - aa1e5b37 by Sven Tennie at 2020-09-11T08:17:16+02:00 Add test for StgTSO decoding (#18405) This makes sure ghc-heap decodes StgTSO and StgStack correctly. To assert - otherwise dynamic - properties, a new, non-running TSO is created in create_tso() (create_tso.c). size is renamed to stack_size to use a dedicated type. size was already defined as a HalfWord in GenClosure, which is only equivalent to Word32 on 64bit architectures. - - - - - 6e6a3207 by Sven Tennie at 2020-09-11T08:17:16+02:00 Add documentation to ghc-debug functions (#18405) - - - - - 56b1eb08 by Sven Tennie at 2020-09-11T08:17:16+02:00 Adjust type of getClosureX to type of getClosureDataX (#18405) After a rebase the compiler complained: libraries/ghc-heap/GHC/Exts/Heap.hs:89:23: error: • Couldn't match type: a -> IO (Ptr StgInfoTable, [Word], [b]) with: forall c. c -> IO (Ptr StgInfoTable, [Word], [b]) Expected: (forall c. c -> IO (Ptr StgInfoTable, [Word], [b])) -> a -> IO (GenClosure b) Actual: (a -> IO (Ptr StgInfoTable, [Word], [b])) -> a -> IO (GenClosure b) • In the expression: getClosureX In an equation for ‘getClosureDataX’: getClosureDataX = getClosureX In the instance declaration for ‘HasHeapRep a’ • Relevant bindings include getClosureDataX :: (forall c. c -> IO (Ptr StgInfoTable, [Word], [b])) -> a -> IO (GenClosure b) (bound at libraries/ghc-heap/GHC/Exts/Heap.hs:89:5) | 89 | getClosureDataX = getClosureX | ^^^^^^^^^^^ ) - - - - - 84708c1d by Sven Tennie at 2020-09-11T08:17:16+02:00 Add test for rts_pause and rts_unpause (#18405) - - - - - b33e3f6f by Sven Tennie at 2020-09-11T08:17:16+02:00 Add test list_threads_and_misc_roots (#18405) It uses rts_listThreads() and rts_listMiscRoots(). - - - - - 1efdfa6c by Sven Tennie at 2020-09-11T08:17:16+02:00 Introduce rts_isPaused() (#18405) Some operations are only save when the RTS is paused. This predicate helps to make such checks. - - - - - 647e137a by Sven Tennie at 2020-09-11T08:17:16+02:00 Decode CostCentreStacks, CostCentres and InfoTables (#18405) These are the data structures used by profiling, i.e. they are only available when the RTS is used with `-prof`. Otherwise fetching them results into `Nothing`. To reduce unnecessary decoding, a state monad transformer is used to provide caching for CostCentres. Because the three types form a circular data structure, loop-breakers are applied to prevent endless decoding loops. - - - - - e46201da by Sven Tennie at 2020-09-11T08:17:16+02:00 Use more precise types in tests (#18405) Use `Ptr ()` instead of `Word` to communicate that addresses/pointers are meant. - - - - - f2c6bbd5 by Sven Tennie at 2020-09-11T08:17:16+02:00 Introduce LiftedClosure (#18405) This is a representation for closures that do not have a representation in the Haskell language. I.e. things like StgTSOs. - - - - - 23ac6c62 by Sven Tennie at 2020-09-11T08:17:16+02:00 Expect stack_marking starting from GHC 8.10 (#18405) This field was introduced with GHC 8.10. - - - - - 8a887a08 by Sven Tennie at 2020-09-11T08:17:16+02:00 Add WhatNext, WhyBlocked and TsoFlags to TSO closure (#18405) These constants can easily be decoded to sum types. Additionally extract TestUtils with common test functions. - - - - - 2c975c12 by Sven Tennie at 2020-09-11T08:17:16+02:00 END_TSO_QUEUE is not a closure type on it's own (#18405) Indeed it's a CONSTR_NOCAF. - - - - - ab2179b1 by Sven Tennie at 2020-09-11T08:17:16+02:00 Rename boundTaskExiting and getTask (#18405) Both are directly related to myTask, which the new names now reflect. - - - - - c9c4df53 by Sven Tennie at 2020-09-11T08:17:16+02:00 Mark unsafe accesses (#18405) StgTSO and StgStack are very dynamic by nature. Accesses to outdated pointers lead to segmentation faults or absolutely wrong results. So, make sure (by naming) that the users nows about these facts. The safe way to access these fields it to stop the RTS via RTS API. - - - - - 90322ac3 by Sven Tennie at 2020-09-11T08:17:16+02:00 Check pointers with pattern matching (#18405) This is nicer than to check the length of the pointer's list and index on it. - - - - - b113405d by Sven Tennie at 2020-09-11T08:17:16+02:00 Remove unsave function (#18405) heap_view_closurePtrsAsWords is currently only used by ghc-debug, so it can be defined there. - - - - - 0905d06a by Sven Tennie at 2020-09-11T08:17:16+02:00 Define a public API for Printer.c (#18405) The RtsAPI contains functions to inspect the heap. The published Printer.c functions help to print the found closures. - - - - - e7f21df8 by Sven Tennie at 2020-09-11T08:17:16+02:00 Do not require ClosureTypes to be Bounded (#18405) A small change to list_threads_and_misc_roots.hs and being Bounded isn't necessary anymore. - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/Names.hs - compiler/GHC/Builtin/Types/Literals.hs - compiler/GHC/Builtin/Utils.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Cmm/CLabel.hs - compiler/GHC/Cmm/Expr.hs - compiler/GHC/Cmm/LayoutStack.hs - compiler/GHC/Cmm/Lint.hs - compiler/GHC/Cmm/Liveness.hs - compiler/GHC/Cmm/Node.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/ProcPoint.hs - compiler/GHC/Cmm/Sink.hs - compiler/GHC/Cmm/Switch/Implement.hs - compiler/GHC/CmmToAsm/CFG/Dominators.hs - compiler/GHC/CmmToAsm/Reg/Linear.hs - compiler/GHC/CmmToC.hs - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Axiom.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/DataCon.hs-boot - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Map.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a89b21e6ebbf4b92d81e6675bc43ee07d5f9e44...e7f21df8dd7c442ebb5874006cc465d4ca2f5bfe -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7a89b21e6ebbf4b92d81e6675bc43ee07d5f9e44...e7f21df8dd7c442ebb5874006cc465d4ca2f5bfe You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 08:01:09 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 11 Sep 2020 04:01:09 -0400 Subject: [Git][ghc/ghc][wip/T18649] 25 commits: Add clarification regarding poll/kqueue flags Message-ID: <5f5b2ec5eda39_80b3f8434fca470115324f2@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18649 at Glasgow Haskell Compiler / GHC Commits: c5413fc6 by Wander Hillen at 2020-09-07T09:33:54-04:00 Add clarification regarding poll/kqueue flags - - - - - 10434d60 by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Configure bignum backend in Hadrian builds - - - - - d4bc9f0d by Ben Gamari at 2020-09-07T09:34:32-04:00 gitlab-ci: Use hadrian builds for Windows release artifacts - - - - - 4ff93292 by Moritz Angermann at 2020-09-07T21:18:39-04:00 [macOS] improved runpath handling In b592bd98ff25730bbe3c13d6f62a427df8c78e28 we started using -dead_strip_dylib on macOS when lining dynamic libraries and binaries. The underlying reason being the Load Command Size Limit in macOS Sierra (10.14) and later. GHC will produce @rpath/libHS... dependency entries together with a corresponding RPATH entry pointing to the location of the libHS... library. Thus for every library we produce two Load Commands. One to specify the dependent library, and one with the path where to find it. This makes relocating libraries and binaries easier, as we just need to update the RPATH entry with the install_name_tool. The dynamic linker will then subsitute each @rpath with the RPATH entries it finds in the libraries load commands or the environement, when looking up @rpath relative libraries. -dead_strip_dylibs intructs the linker to drop unused libraries. This in turn help us reduce the number of referenced libraries, and subsequently the size of the load commands. This however does not remove the RPATH entries. Subsequently we can end up (in extreme cases) with only a single @rpath/libHS... entry, but 100s or more RPATH entries in the Load Commands. This patch rectifies this (slighly unorthodox) by passing *no* -rpath arguments to the linker at link time, but -headerpad 8000. The headerpad argument is in hexadecimal and the maxium 32k of the load command size. This tells the linker to pad the load command section enough for us to inject the RPATHs later. We then proceed to link the library or binary with -dead_strip_dylibs, and *after* the linking inspect the library to find the left over (non-dead-stripped) dependencies (using otool). We find the corresponding RPATHs for each @rpath relative dependency, and inject them into the library or binary using the install_name_tool. Thus achieving a deadstripped dylib (and rpaths) build product. We can not do this in GHC, without starting to reimplement a dynamic linker as we do not know which symbols and subsequently libraries are necessary. Commissioned-by: Mercury Technologies, Inc. (mercury.com) - - - - - df04b81e by Sylvain Henry at 2020-09-07T21:19:20-04:00 Move DynFlags test into updateModDetailsIdInfos's caller (#17957) - - - - - ea1cbb8f by Ben Gamari at 2020-09-08T15:42:02-04:00 rts: Add stg_copyArray_barrier to RtsSymbols list It's incredible that this wasn't noticed until now. - - - - - d7b2f799 by Daishi Nakajima at 2020-09-08T15:42:41-04:00 testsuite: Output performance test results in tabular format this was suggested in #18417. Change the print format of the values. * Shorten commit hash * Reduce precision of the "Value" field * Shorten metrics name * e.g. runtime/bytes allocated -> run/alloc * Shorten "MetricsChange" * e.g. unchanged -> unch, increased -> incr And, print the baseline environment if there are baselines that were measured in a different environment than the current environment. If all "Baseline commit" are the same, print it once. - - - - - 44472daf by Ryan Scott at 2020-09-08T15:43:16-04:00 Make the forall-or-nothing rule only apply to invisible foralls (#18660) This fixes #18660 by changing `isLHsForAllTy` to `isLHsInvisForAllTy`, which is sufficient to make the `forall`-or-nothing rule only apply to invisible `forall`s. I also updated some related documentation and Notes while I was in the neighborhood. - - - - - 0c61cbff by Ben Gamari at 2020-09-08T15:43:54-04:00 gitlab-ci: Handle distributions without locales Previously we would assume that the `locale` utility exists. However, this is not so on Alpine as musl's locale support is essentially non-existent. (cherry picked from commit 17cdb7ac3b557a245fee1686e066f9f770ddc21e) - - - - - d989c842 by Ben Gamari at 2020-09-08T15:43:55-04:00 gitlab-ci: Accept Centos 7 C.utf8 locale Centos apparently has C.utf8 rather than C.UTF-8. (cherry picked from commit d9f85dd25a26a04d3485470afb3395ee2dec6464) - - - - - e5a2899c by John Ericson at 2020-09-09T00:46:05-04:00 Use "to" instead of "2" in internal names of conversion ops Change the constructors for the primop union, and also names of the literal conversion functions. "2" runs into trouble when we need to do conversions from fixed-width types, and end up with thing like "Int642Word". Only the names internal to GHC are changed, as I don't want to worry about breaking changes ATM. - - - - - 822f1057 by Ryan Scott at 2020-09-09T00:46:41-04:00 Postpone associated tyfam default checks until after typechecking Previously, associated type family defaults were validity-checked during typechecking. Unfortunately, the error messages that these checks produce run the risk of printing knot-tied type constructors, which will cause GHC to diverge. In order to preserve the current error message's descriptiveness, this patch postpones these validity checks until after typechecking, which are now located in the new function `GHC.Tc.Validity.checkValidAssocTyFamDeflt`. Fixes #18648. - - - - - 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 26da024c by Simon Peyton Jones at 2020-09-11T09:00:46+01:00 Care with implicit-parameter superclasses Two bugs, #18627 and #18649, had the same cause: we were not account for the fact that a constaint tuple might hide an implicit parameter. The solution is not hard: look for implicit parameters in superclasses. See Note [Local implicit parameters] in GHC.Core.Predicate. Then we use this new function in two places * The "short-cut solver" in GHC.Tc.Solver.Interact.shortCutSolver which simply didn't handle implicit parameters properly at all. This fixes #18627 * The specialiser, which should not specialise on implicit parameters This fixes #18649 There are some lingering worries (see Note [Local implicit parameters]) but things are much better. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - aclocal.m4 - compiler/GHC.hs - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Class.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Core/SimpleOpt.hs - + compiler/GHC/Core/SimpleOpt.hs-boot - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold.hs-boot - + compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - + compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Finder.hs - compiler/GHC/Driver/Main.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92763148864d75b2096d999203dd3e18f8628eaf...26da024c535a8cb6bcbc678571c5e6312f977974 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/92763148864d75b2096d999203dd3e18f8628eaf...26da024c535a8cb6bcbc678571c5e6312f977974 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 08:04:30 2020 From: gitlab at gitlab.haskell.org (Sven Tennie) Date: Fri, 11 Sep 2020 04:04:30 -0400 Subject: [Git][ghc/ghc][wip/ghc-debug] Assure RTS is not paused after rts_unpause() (#18405) Message-ID: <5f5b2f8e67acd_80b3f84597d232411535754@gitlab.haskell.org.mail> Sven Tennie pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC Commits: f8b8f2a1 by Sven Tennie at 2020-09-11T10:04:18+02:00 Assure RTS is not paused after rts_unpause() (#18405) Assert this invariant in tests. - - - - - 1 changed file: - testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c Changes: ===================================== testsuite/tests/rts/ghc-debug/pause_and_unpause_thread.c ===================================== @@ -23,6 +23,11 @@ void* pauseAndUnpause_thread(void* unused){ rts_unpause(r_paused); + if(rts_isPaused()) { + errorBelch("Expected the RTS to be unpaused."); + exit(1); + } + return NULL; } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8b8f2a147e7df9a57cdcbd61c9ae1f7a9c0eb0e -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f8b8f2a147e7df9a57cdcbd61c9ae1f7a9c0eb0e You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 08:15:34 2020 From: gitlab at gitlab.haskell.org (Simon Peyton Jones) Date: Fri, 11 Sep 2020 04:15:34 -0400 Subject: [Git][ghc/ghc][wip/T18649] Care with implicit-parameter superclasses Message-ID: <5f5b3226e229b_80b8a88664115408f3@gitlab.haskell.org.mail> Simon Peyton Jones pushed to branch wip/T18649 at Glasgow Haskell Compiler / GHC Commits: f0789d99 by Simon Peyton Jones at 2020-09-11T09:14:58+01:00 Care with implicit-parameter superclasses Two bugs, #18627 and #18649, had the same cause: we were not account for the fact that a constaint tuple might hide an implicit parameter. The solution is not hard: look for implicit parameters in superclasses. See Note [Local implicit parameters] in GHC.Core.Predicate. Then we use this new function in two places * The "short-cut solver" in GHC.Tc.Solver.Interact.shortCutSolver which simply didn't handle implicit parameters properly at all. This fixes #18627 * The specialiser, which should not specialise on implicit parameters This fixes #18649 There are some lingering worries (see Note [Local implicit parameters]) but things are much better. - - - - - 16 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver.hs - compiler/GHC/Tc/Solver/Canonical.hs - compiler/GHC/Tc/Solver/Interact.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/TyCl/Instance.hs - compiler/GHC/Tc/Utils/TcType.hs - + testsuite/tests/simplCore/should_compile/T18649.hs - + testsuite/tests/simplCore/should_compile/T18649.stderr - testsuite/tests/simplCore/should_compile/all.T - + testsuite/tests/typecheck/should_run/T18627.hs - + testsuite/tests/typecheck/should_run/T18627.stdout - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2514,9 +2514,12 @@ mkCallUDs' env f args -- we decide on a case by case basis if we want to specialise -- on this argument; if so, SpecDict, if not UnspecArg mk_spec_arg arg (Anon InvisArg pred) - | type_determines_value (scaledThing pred) - , interestingDict env arg -- Note [Interesting dictionary arguments] + | not (isIPLikePred (scaledThing pred)) + -- See Note [Type determines value] + , interestingDict env arg + -- See Note [Interesting dictionary arguments] = SpecDict arg + | otherwise = UnspecArg mk_spec_arg _ (Anon VisArg _) @@ -2529,41 +2532,18 @@ mkCallUDs' env f args -- in specImports -- Use 'realIdUnfolding' to ignore the loop-breaker flag! - type_determines_value pred -- See Note [Type determines value] - = case classifyPredType pred of - ClassPred cls _ -> not (isIPClass cls) -- Superclasses can't be IPs - EqPred {} -> True - IrredPred {} -> True -- Things like (D []) where D is a - -- Constraint-ranged family; #7785 - ForAllPred {} -> True - -{- -Note [Type determines value] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Only specialise on non-IP *class* params, because these are the ones -whose *type* determines their *value*. In particular, with implicit -params, the type args *don't* say what the value of the implicit param -is! See #7101. +{- Note [Type determines value] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Only specialise on non-impicit-parameter predicates, because these +are the ones whose *type* determines their *value*. In particular, +with implicit params, the type args *don't* say what the value of the +implicit param is! See #7101. So we treat implicit params just like ordinary arguments for the purposes of specialisation. Note that we still want to specialise functions with implicit params if they have *other* dicts which are class params; see #17930. -One apparent additional complexity involves type families. For -example, consider - type family D (v::*->*) :: Constraint - type instance D [] = () - f :: D v => v Char -> Int -If we see a call (f "foo"), we'll pass a "dictionary" - () |> (g :: () ~ D []) -and it's good to specialise f at this dictionary. - -So the question is: can an implicit parameter "hide inside" a -type-family constraint like (D a). Well, no. We don't allow - type instance D Maybe = ?x:Int -Hence the IrredPred case in type_determines_value. See #7785. - Note [Interesting dictionary arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -20,9 +20,10 @@ module GHC.Core.Predicate ( mkClassPred, isDictTy, isClassPred, isEqPredClass, isCTupleClass, getClassPredTys, getClassPredTys_maybe, + classMethodTy, classMethodInstTy, -- Implicit parameters - isIPPred, isIPPred_maybe, isIPTyCon, isIPClass, hasIPPred, + isIPLikePred, hasIPSuperClasses, isIPTyCon, isIPClass, -- Evidence variables DictId, isEvVar, isDictId @@ -39,12 +40,10 @@ import GHC.Core.Multiplicity ( scaledThing ) import GHC.Builtin.Names -import GHC.Data.FastString import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic -import Control.Monad ( guard ) -- | A predicate in the solver. The solver tries to prove Wanted predicates -- from Given ones. @@ -95,6 +94,26 @@ getClassPredTys_maybe ty = case splitTyConApp_maybe ty of Just (tc, tys) | Just clas <- tyConClass_maybe tc -> Just (clas, tys) _ -> Nothing +classMethodTy :: Id -> Type +-- Takes a class selector op :: forall a. C a => meth_ty +-- and returns the type of its method, meth_ty +-- The selector can be a superclass selector, in which case +-- you get back a superclass +classMethodTy sel_id + = funResultTy $ -- meth_ty + dropForAlls $ -- C a => meth_ty + varType sel_id -- forall a. C n => meth_ty + +classMethodInstTy :: Id -> [Type] -> Type +-- Takes a class selector op :: forall a b. C a b => meth_ty +-- and the types [ty1, ty2] at which it is instantiated, +-- returns the instantiated type of its method, meth_ty[t1/a,t2/b] +-- The selector can be a superclass selector, in which case +-- you get back a superclass +classMethodInstTy sel_id arg_tys + = funResultTy $ + piResultTys (varType sel_id) arg_tys + -- --------------------- Equality predicates --------------------------------- -- | A choice of equality relation. This is separate from the type 'Role' @@ -170,7 +189,7 @@ isEqPredClass :: Class -> Bool isEqPredClass cls = cls `hasKey` eqTyConKey || cls `hasKey` heqTyConKey -isClassPred, isEqPred, isEqPrimPred, isIPPred :: PredType -> Bool +isClassPred, isEqPred, isEqPrimPred :: PredType -> Bool isClassPred ty = case tyConAppTyCon_maybe ty of Just tyCon | isClassTyCon tyCon -> True _ -> False @@ -186,9 +205,15 @@ isEqPred ty -- True of (a ~ b) and (a ~~ b) isEqPrimPred ty = isCoVarType ty -- True of (a ~# b) (a ~R# b) -isIPPred ty = case tyConAppTyCon_maybe ty of - Just tc -> isIPTyCon tc - _ -> False +isCTupleClass :: Class -> Bool +isCTupleClass cls = isTupleTyCon (classTyCon cls) + + +{- ********************************************************************* +* * + Implicit parameters +* * +********************************************************************* -} isIPTyCon :: TyCon -> Bool isIPTyCon tc = tc `hasKey` ipClassKey @@ -197,31 +222,103 @@ isIPTyCon tc = tc `hasKey` ipClassKey isIPClass :: Class -> Bool isIPClass cls = cls `hasKey` ipClassKey -isCTupleClass :: Class -> Bool -isCTupleClass cls = isTupleTyCon (classTyCon cls) +isIPLikePred :: Type -> Bool +-- See Note [Local implicit parameters] +isIPLikePred = is_ip_like_pred initIPRecTc -isIPPred_maybe :: Type -> Maybe (FastString, Type) -isIPPred_maybe ty = - do (tc,[t1,t2]) <- splitTyConApp_maybe ty - guard (isIPTyCon tc) - x <- isStrLitTy t1 - return (x,t2) - -hasIPPred :: PredType -> Bool -hasIPPred pred - = case classifyPredType pred of - ClassPred cls tys - | isIPClass cls -> True - | isCTupleClass cls -> any hasIPPred tys - _other -> False -{- -************************************************************************ +is_ip_like_pred :: RecTcChecker -> Type -> Bool +is_ip_like_pred rec_clss ty + | Just (tc, tys) <- splitTyConApp_maybe ty + , Just rec_clss' <- if isTupleTyCon tc -- Tuples never cause recursion + then Just rec_clss + else checkRecTc rec_clss tc + , Just cls <- tyConClass_maybe tc + = isIPClass cls || has_ip_super_classes rec_clss' cls tys + + | otherwise + = False -- Includes things like (D []) where D is + -- a Constraint-ranged family; #7785 + +hasIPSuperClasses :: Class -> [Type] -> Bool +-- See Note [Local implicit parameters] +hasIPSuperClasses = has_ip_super_classes initIPRecTc + +has_ip_super_classes :: RecTcChecker -> Class -> [Type] -> Bool +has_ip_super_classes rec_clss cls tys + = any ip_ish (classSCSelIds cls) + where + -- Check that the type of a superclass determines its value + -- sc_sel_id :: forall a b. C a b -> + ip_ish sc_sel_id = is_ip_like_pred rec_clss $ + classMethodInstTy sc_sel_id tys + +initIPRecTc :: RecTcChecker +initIPRecTc = setRecTcMaxBound 1 initRecTc + +{- Note [Local implicit parameters] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The function isIPLikePred tells if this predicate, or any of its +superclasses, is an implicit parameter. + +Why are implicit parameters special? Unlike normal classes, we can +have local instances for implicit parameters, in the form of + let ?x = True in ... +So in various places we must be careful not to assume that any value +of the right type will do; we must carefully look for the innermost binding. +So isIPLikePred checks whether this is an implicit parameter, or has +a superclass that is an implicit parameter. + +Several wrinkles + +* We must be careful with superclasses, as #18649 showed. Haskell + doesn't allow an implicit parameter as a superclass + class (?x::a) => C a where ... + but with a constraint tuple we might have + (% Eq a, ?x::Int %) + and /its/ superclasses, namely (Eq a) and (?x::Int), /do/ include an + implicit parameter. + + With ConstraintKinds this can apply to /any/ class, e.g. + class sc => C sc where ... + Then (C (?x::Int)) has (?x::Int) as a superclass. So we must + instantiate and check each superclass, one by one, in + hasIPSuperClasses. + +* With -XRecursiveSuperClasses, the superclass hunt can go on forever, + so we need a RecTcChecker to cut it off. + +* Another apparent additional complexity involves type families. For + example, consider + type family D (v::*->*) :: Constraint + type instance D [] = () + f :: D v => v Char -> Int + If we see a call (f "foo"), we'll pass a "dictionary" + () |> (g :: () ~ D []) + and it's good to specialise f at this dictionary. + +So the question is: can an implicit parameter "hide inside" a +type-family constraint like (D a). Well, no. We don't allow + type instance D Maybe = ?x:Int +Hence the umbrella 'otherwise' case in is_ip_like_pred. See #7785. + +Small worries (Sept 20): +* I don't see what stops us having that 'type instance'. Indeed I + think nothing does. +* I'm a little concerned about type variables; such a variable might + be instantiated to an implicit parameter. I don't think this + matters in the cases for which isIPLikePred is used, and it's pretty + obscure anyway. +* The superclass hunt stops when it encounters the same class again, + but in principle we could have the same class, differently instantiated, + and the second time it could have an implicit parameter +I'm going to treat these as problems for another day. They are all exotic. -} + +{- ********************************************************************* * * Evidence variables * * -************************************************************************ --} +********************************************************************* -} isEvVar :: Var -> Bool isEvVar var = isEvVarType (varType var) ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -388,10 +388,9 @@ makeLitDict clas ty et | Just (_, co_dict) <- tcInstNewTyCon_maybe (classTyCon clas) [ty] -- co_dict :: KnownNat n ~ SNat n , [ meth ] <- classMethods clas - , Just tcRep <- tyConAppTyCon_maybe -- SNat - $ funResultTy -- SNat n - $ dropForAlls -- KnownNat n => SNat n - $ idType meth -- forall n. KnownNat n => SNat n + , Just tcRep <- tyConAppTyCon_maybe (classMethodTy meth) + -- If the method type is forall n. KnownNat n => SNat n + -- then tcRep is SNat , Just (_, co_rep) <- tcInstNewTyCon_maybe tcRep [ty] -- SNat n ~ Integer , let ev_tm = mkEvCast et (mkTcSymCo (mkTcTransCo co_dict co_rep)) ===================================== compiler/GHC/Tc/Module.hs ===================================== @@ -65,9 +65,10 @@ import GHC.Builtin.Types ( unitTy, mkListTy ) import GHC.Driver.Plugins import GHC.Driver.Session import GHC.Hs -import GHC.Iface.Syntax ( ShowSub(..), showToHeader ) -import GHC.Iface.Type ( ShowForAllFlag(..) ) -import GHC.Core.PatSyn( pprPatSynType ) +import GHC.Iface.Syntax ( ShowSub(..), showToHeader ) +import GHC.Iface.Type ( ShowForAllFlag(..) ) +import GHC.Core.PatSyn ( pprPatSynType ) +import GHC.Core.Predicate ( classMethodTy ) import GHC.Builtin.Names import GHC.Builtin.Utils import GHC.Types.Name.Reader @@ -1014,10 +1015,8 @@ checkBootTyCon is_boot tc1 tc2 name2 = idName id2 pname1 = quotes (ppr name1) pname2 = quotes (ppr name2) - (_, rho_ty1) = splitForAllTys (idType id1) - op_ty1 = funResultTy rho_ty1 - (_, rho_ty2) = splitForAllTys (idType id2) - op_ty2 = funResultTy rho_ty2 + op_ty1 = classMethodTy id1 + op_ty2 = classMethodTy id2 eqAT (ATI tc1 def_ats1) (ATI tc2 def_ats2) = checkBootTyCon is_boot tc1 tc2 `andThenCheck` ===================================== compiler/GHC/Tc/Solver.hs ===================================== @@ -1377,7 +1377,7 @@ growThetaTyVars theta tcvs | otherwise = transCloVarSet mk_next seed_tcvs where seed_tcvs = tcvs `unionVarSet` tyCoVarsOfTypes ips - (ips, non_ips) = partition isIPPred theta + (ips, non_ips) = partition isIPLikePred theta -- See Note [Inheriting implicit parameters] in GHC.Tc.Utils.TcType mk_next :: VarSet -> VarSet -- Maps current set to newly-grown ones ===================================== compiler/GHC/Tc/Solver/Canonical.hs ===================================== @@ -29,7 +29,7 @@ import GHC.Core.Multiplicity import GHC.Core.TyCo.Rep -- cleverly decomposes types, good for completeness checking import GHC.Core.Coercion import GHC.Core -import GHC.Types.Id( idType, mkTemplateLocals ) +import GHC.Types.Id( mkTemplateLocals ) import GHC.Core.FamInstEnv ( FamInstEnvs ) import GHC.Tc.Instance.Family ( tcTopNormaliseNewTypeTF_maybe ) import GHC.Types.Var @@ -542,7 +542,7 @@ mk_strict_superclasses rec_clss (CtGiven { ctev_evar = evar, ctev_loc = loc }) mk_given_desc sel_id sc_pred ; mk_superclasses rec_clss given_ev tvs theta sc_pred } where - sc_pred = funResultTy (piResultTys (idType sel_id) tys) + sc_pred = classMethodInstTy sel_id tys -- See Note [Nested quantified constraint superclasses] mk_given_desc :: Id -> PredType -> (PredType, EvTerm) ===================================== compiler/GHC/Tc/Solver/Interact.hs ===================================== @@ -566,10 +566,10 @@ solveOneFromTheOther ev_i ev_w ev_id_w = ctEvEvId ev_w different_level_strategy -- Both Given - | isIPPred pred = if lvl_w > lvl_i then KeepWork else KeepInert - | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork + | isIPLikePred pred = if lvl_w > lvl_i then KeepWork else KeepInert + | otherwise = if lvl_w > lvl_i then KeepInert else KeepWork -- See Note [Replacement vs keeping] (the different-level bullet) - -- For the isIPPred case see Note [Shadowing of Implicit Parameters] + -- For the isIPLikePred case see Note [Shadowing of Implicit Parameters] same_level_strategy binds -- Both Given | GivenOrigin (InstSC s_i) <- ctLocOrigin loc_i @@ -1071,6 +1071,8 @@ shortCutSolver dflags ev_w ev_i -- programs should typecheck regardless of whether we take this step or -- not. See Note [Shortcut solving] + && not (isIPLikePred (ctEvPred ev_w)) -- Not for implicit parameters (#18627) + && not (xopt LangExt.IncoherentInstances dflags) -- If IncoherentInstances is on then we cannot rely on coherence of proofs -- in order to justify this optimization: The proof provided by the @@ -1079,6 +1081,7 @@ shortCutSolver dflags ev_w ev_i && gopt Opt_SolveConstantDicts dflags -- Enabled by the -fsolve-constant-dicts flag + = do { ev_binds_var <- getTcEvBindsVar ; ev_binds <- ASSERT2( not (isCoEvBindsVar ev_binds_var ), ppr ev_w ) getTcEvBindsMap ev_binds_var ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -2527,8 +2527,7 @@ emptyDictMap = emptyTcAppMap findDict :: DictMap a -> CtLoc -> Class -> [Type] -> Maybe a findDict m loc cls tys - | isCTupleClass cls - , any hasIPPred tys -- See Note [Tuples hiding implicit parameters] + | hasIPSuperClasses cls tys -- See Note [Tuples hiding implicit parameters] = Nothing | Just {} <- isCallStackPred cls tys ===================================== compiler/GHC/Tc/TyCl/Instance.hs ===================================== @@ -54,6 +54,7 @@ import GHC.Core.Make ( nO_METHOD_BINDING_ERROR_ID ) import GHC.Core.Unfold.Make ( mkInlineUnfoldingWithArity, mkDFunUnfolding ) import GHC.Core.Type import GHC.Core.SimpleOpt +import GHC.Core.Predicate( classMethodInstTy ) import GHC.Tc.Types.Evidence import GHC.Core.TyCon import GHC.Core.Coercion.Axiom @@ -1634,7 +1635,7 @@ tcMethods dfun_id clas tyvars dfun_ev_vars inst_tys nO_METHOD_BINDING_ERROR_ID error_msg dflags = L inst_loc (HsLit noExtField (HsStringPrim NoSourceText (unsafeMkByteString (error_string dflags)))) - meth_tau = funResultTy (piResultTys (idType sel_id) inst_tys) + meth_tau = classMethodInstTy sel_id inst_tys error_string dflags = showSDoc dflags (hcat [ppr inst_loc, vbar, ppr sel_id ]) lam_wrapper = mkWpTyLams tyvars <.> mkWpLams dfun_ev_vars ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -79,7 +79,7 @@ module GHC.Tc.Utils.TcType ( isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, isBoolTy, isUnitTy, isCharTy, isCallStackTy, isCallStackPred, - hasIPPred, isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, + isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, isPredTy, isTyVarClassPred, isTyVarHead, isInsolubleOccursCheck, checkValidClsArgs, hasTyVarHead, isRigidTy, isAlmostFunctionFree, @@ -141,7 +141,7 @@ module GHC.Tc.Utils.TcType ( mkTyConTy, mkTyVarTy, mkTyVarTys, mkTyCoVarTy, mkTyCoVarTys, - isClassPred, isEqPrimPred, isIPPred, isEqPred, isEqPredClass, + isClassPred, isEqPrimPred, isIPLikePred, isEqPred, isEqPredClass, mkClassPred, tcSplitDFunTy, tcSplitDFunHead, tcSplitMethodTy, isRuntimeRepVar, isKindLevPoly, @@ -1747,7 +1747,7 @@ pickCapturedPreds pickCapturedPreds qtvs theta = filter captured theta where - captured pred = isIPPred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) + captured pred = isIPLikePred pred || (tyCoVarsOfType pred `intersectsVarSet` qtvs) -- Superclasses ===================================== testsuite/tests/simplCore/should_compile/T18649.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} + +module Test where + +import Prelude + +type Hidden a = + ( ?enable :: a + , Eq a -- removing this "fixes" the issue + ) + +{-# NOINLINE a #-} +a :: Hidden Bool => Integer -> Bool +a _ = ?enable + +system :: Hidden Bool => Bool +system = a 0 + +topEntity :: Bool -> Bool +topEntity ena = let ?enable = ena + in system + +someVar = let ?enable = True + in system ===================================== testsuite/tests/simplCore/should_compile/T18649.stderr ===================================== @@ -0,0 +1,4 @@ + +==================== Tidy Core rules ==================== + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -333,3 +333,7 @@ test('T18347', normal, compile, ['-dcore-lint -O']) test('T18355', [ grep_errmsg(r'OneShot') ], compile, ['-O -ddump-simpl -dsuppress-uniques']) test('T18399', normal, compile, ['-dcore-lint -O']) test('T18589', normal, compile, ['-dcore-lint -O']) + +# T18649 should /not/ generate a specialisation rule +test('T18649', normal, compile, ['-O -ddump-rules -Wno-simplifiable-class-constraints']) + ===================================== testsuite/tests/typecheck/should_run/T18627.hs ===================================== @@ -0,0 +1,16 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module Main where + +import GHC.Classes + +instance IP "x" Int where + ip = 21 + +baz :: (?x :: Int) => Int +baz = ?x + +main :: IO () +main = let ?x = 42 + in print baz ===================================== testsuite/tests/typecheck/should_run/T18627.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -146,3 +146,4 @@ test('UnliftedNewtypesDependentFamilyRun', normal, compile_and_run, ['']) test('UnliftedNewtypesIdentityRun', normal, compile_and_run, ['']) test('UnliftedNewtypesCoerceRun', normal, compile_and_run, ['']) test('T17104', normal, compile_and_run, ['']) +test('T18627', normal, compile_and_run, ['-O']) # Optimisation shows up the bug View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0789d995cd92304f8ddcbfba90da5b75f83754d -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f0789d995cd92304f8ddcbfba90da5b75f83754d You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 08:39:09 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Sep 2020 04:39:09 -0400 Subject: [Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: Define TICKY_TICKY when compiling cmm RTS files. Message-ID: <5f5b37ad93c3d_80b3f8487055adc115486b4@gitlab.haskell.org.mail> Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 6110305d by David Himmelstrup at 2020-09-11T04:39:01-04:00 Define TICKY_TICKY when compiling cmm RTS files. - - - - - fa77a695 by David Himmelstrup at 2020-09-11T04:39:01-04:00 Fix typos in TICKY_TICKY symbol names. - - - - - a38de0f2 by David Himmelstrup at 2020-09-11T04:39:02-04:00 Enable TICKY_TICKY for debug builds when building with makefiles. - - - - - 5 changed files: - hadrian/src/Settings/Packages.hs - includes/Cmm.h - includes/stg/Ticky.h - mk/ways.mk - rts/Ticky.c Changes: ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -279,7 +279,8 @@ rtsPackageArgs = package rts ? do , arg $ "-DFS_NAMESPACE=rts" , arg $ "-DCOMPILING_RTS" , notM targetSupportsSMP ? arg "-DNOSMP" - , way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY" + , way `elem` [debug, debugDynamic] ? pure [ "-DTICKY_TICKY" + , "-optc-DTICKY_TICKY"] , Profiling `wayUnit` way ? arg "-DPROFILING" , Threaded `wayUnit` way ? arg "-DTHREADED_RTS" , notM targetSupportsSMP ? pure [ "-DNOSMP" ===================================== includes/Cmm.h ===================================== @@ -660,7 +660,11 @@ #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1) #define TICK_ENT_DYN_IND() TICK_BUMP(ENT_DYN_IND_ctr) -#define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr) +// ENT_DYN_THK_ctr doesn't exist anymore. Could be ENT_DYN_THK_SINGLE_ctr or +// ENT_DYN_THK_MANY_ctr +// #define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr) +#define TICK_ENT_DYN_THK() + #define TICK_ENT_VIA_NODE() TICK_BUMP(ENT_VIA_NODE_ctr) #define TICK_ENT_STATIC_IND() TICK_BUMP(ENT_STATIC_IND_ctr) #define TICK_ENT_PERM_IND() TICK_BUMP(ENT_PERM_IND_ctr) ===================================== includes/stg/Ticky.h ===================================== @@ -199,18 +199,23 @@ EXTERN StgInt RET_UNBOXED_TUP_hst[TICKY_BIN_COUNT] INIT({0}); TICKY_TICKY is defined or not. */ #if !defined(CMINUSMINUS) +#if defined(TICKY_TICKY) #define TICK_BUMP_BY(ctr,n) ctr = (StgInt) ctr + n +#else +#define TICK_BUMP_BY(ctr,n) /* nothing */ +#endif + #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1) -#define TICK_ALLOC_PRIM(x,y,z) -#define TICK_UPD_OLD_IND() -#define TICK_UPD_NEW_IND() -#define TICK_UPD_SQUEEZED() -#define TICK_ALLOC_HEAP_NOCTR(bytes) -#define TICK_GC_FAILED_PROMOTION() -#define TICK_ALLOC_TSO() -#define TICK_ALLOC_STACK(g) -#define TICK_ALLOC_UP_THK(g,s) -#define TICK_ALLOC_SE_THK(g,s) +#define TICK_ALLOC_PRIM(x,y,z) // FIXME: update counter +#define TICK_UPD_OLD_IND() TICK_BUMP(UPD_OLD_IND_ctr) +#define TICK_UPD_NEW_IND() TICK_BUMP(UPD_NEW_IND_ctr) +#define TICK_UPD_SQUEEZED() TICK_BUMP(UPD_SQUEEZED_ctr) +#define TICK_ALLOC_HEAP_NOCTR(bytes) // FIXME: update counter +#define TICK_GC_FAILED_PROMOTION() // FIXME: update counter +#define TICK_ALLOC_TSO() // FIXME: update counter +#define TICK_ALLOC_STACK(g) // FIXME: update counter +#define TICK_ALLOC_UP_THK(g,s) // FIXME: update counter +#define TICK_ALLOC_SE_THK(g,s) // FIXME: update counter #endif ===================================== mk/ways.mk ===================================== @@ -70,7 +70,7 @@ WAY_thr_l_HC_OPTS= -static -optc-DTHREADED_RTS -eventlog # Way 'debug': WAY_debug_NAME=debug -WAY_debug_HC_OPTS= -static -optc-DDEBUG -ticky -DTICKY_TICKY -eventlog +WAY_debug_HC_OPTS= -static -optc-DDEBUG -ticky -DTICKY_TICKY -optc-DTICKY_TICKY -eventlog # Way 'debug_p': WAY_debug_p_NAME=debug profiled @@ -110,7 +110,7 @@ WAY_thr_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DTHREADED_RTS -optc-DDEBUG -event # Way 'debug_dyn': WAY_debug_dyn_NAME=debug_dyn -WAY_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DDEBUG -ticky -DTICKY_TICKY -eventlog +WAY_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DDEBUG -ticky -DTICKY_TICKY -optc-DTICKY_TICKY -eventlog # Way 'l_dyn': WAY_l_dyn_NAME=event logging dynamic ===================================== rts/Ticky.c ===================================== @@ -261,7 +261,7 @@ PrintTickyInfo(void) * * This of course refers to the -ticky version that uses PERM_INDs to * determine the number of closures entered 0/1/>1. KSW 1999-04. */ - COND_PR_CTR(ENT_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"E!NT_PERM_IND_ctr requires +RTS -Z"); + COND_PR_CTR(ENT_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"ENT_PERM_IND_ctr requires +RTS -Z"); PR_CTR(ENT_AP_ctr); PR_CTR(ENT_PAP_ctr); @@ -334,10 +334,10 @@ PrintTickyInfo(void) PR_CTR(UPD_NEW_IND_ctr); /* see comment on ENT_PERM_IND_ctr */ - COND_PR_CTR(UPD_NEW_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"U!PD_NEW_PERM_IND_ctr requires +RTS -Z"); + COND_PR_CTR(UPD_NEW_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"UPD_NEW_PERM_IND_ctr requires +RTS -Z"); PR_CTR(UPD_OLD_IND_ctr); /* see comment on ENT_PERM_IND_ctr */ - COND_PR_CTR(UPD_OLD_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"U!PD_OLD_PERM_IND_ctr requires +RTS -Z"); + COND_PR_CTR(UPD_OLD_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"UPD_OLD_PERM_IND_ctr requires +RTS -Z"); PR_CTR(GC_SEL_ABANDONED_ctr); PR_CTR(GC_SEL_MINOR_ctr); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d241dc01d4fd70c9018e193869e5d5641170d039...a38de0f2a41e81fe43bdb605a8f763bd9bdfe48c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d241dc01d4fd70c9018e193869e5d5641170d039...a38de0f2a41e81fe43bdb605a8f763bd9bdfe48c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 08:47:02 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 11 Sep 2020 04:47:02 -0400 Subject: [Git][ghc/ghc][wip/T14422] 18 commits: DynFlags: add OptCoercionOpts Message-ID: <5f5b3986cb014_80b3f845871d6c8115488ee@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14422 at Glasgow Haskell Compiler / GHC Commits: 8c892689 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add OptCoercionOpts Use OptCoercionOpts to avoid threading DynFlags all the way down to GHC.Core.Coercion.Opt - - - - - 3f32a9c0 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add UnfoldingOpts and SimpleOpts Milestone: after this patch, we only use 'unsafeGlobalDynFlags' for the state hack and for debug in Outputable. - - - - - b3df72a6 by Sylvain Henry at 2020-09-09T11:19:24-04:00 DynFlags: add sm_pre_inline field into SimplMode (#17957) It avoids passing and querying DynFlags down in the simplifier. - - - - - ffae5792 by Sylvain Henry at 2020-09-09T11:19:24-04:00 Add comments about sm_dflags and simpleOptExpr - - - - - 7911d0d9 by Alan Zimmerman at 2020-09-09T11:20:03-04:00 Remove GENERATED pragma, as it is not being used @alanz pointed out on ghc-devs that the payload of this pragma does not appear to be used anywhere. I (@bgamari) did some digging and traced the pragma's addition back to d386e0d2 (way back in 2006!). It appears that it was intended to be used by code generators for use in informing the code coveraging checker about generated code provenance. When it was added it used the pragma's "payload" fields as source location information to build an "ExternalBox". However, it looks like this was dropped a year later in 55a5d8d9. At this point it seems like the pragma serves no useful purpose. Given that it also is not documented, I think we should remove it. Updates haddock submodule Closes #18639 - - - - - 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - 67ce72da by Sebastian Graf at 2020-09-10T10:35:33-04:00 Add long-distance info for pattern bindings (#18572) We didn't consider the RHS of a pattern-binding before, which led to surprising warnings listed in #18572. As can be seen from the regression test T18572, we get the expected output now. - - - - - 1207576a by Sebastian Graf at 2020-09-10T10:35:33-04:00 PmCheck: Big refactor using guard tree variants more closely following source syntax (#18565) Previously, we desugared and coverage checked plain guard trees as described in Lower Your Guards. That caused (in !3849) quite a bit of pain when we need to partially recover tree structure of the input syntax to return covered sets for long-distance information, for example. In this refactor, I introduced a guard tree variant for each relevant source syntax component of a pattern-match (mainly match groups, match, GRHS, empty case, pattern binding). I made sure to share as much coverage checking code as possible, so that the syntax-specific checking functions are just wrappers around the more substantial checking functions for the LYG primitives (`checkSequence`, `checkGrds`). The refactoring payed off in clearer code and elimination of all panics related to assumed guard tree structure and thus fixes #18565. I also took the liberty to rename and re-arrange the order of functions and comments in the module, deleted some dead and irrelevant Notes, wrote some new ones and gave an overview module haddock. - - - - - 95455982 by GHC GitLab CI at 2020-09-10T10:36:09-04:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #18672. - - - - - 6abe4a1c by Sebastian Graf at 2020-09-10T17:02:00+02:00 .gitignore *.hiedb files - - - - - 3777be14 by Sebastian Graf at 2020-09-10T17:03:12+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 6110305d by David Himmelstrup at 2020-09-11T04:39:01-04:00 Define TICKY_TICKY when compiling cmm RTS files. - - - - - fa77a695 by David Himmelstrup at 2020-09-11T04:39:01-04:00 Fix typos in TICKY_TICKY symbol names. - - - - - a38de0f2 by David Himmelstrup at 2020-09-11T04:39:02-04:00 Enable TICKY_TICKY for debug builds when building with makefiles. - - - - - 25132940 by Sebastian Graf at 2020-09-11T10:46:55+02:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 30 changed files: - .gitignore - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC.hs - compiler/GHC/Core/Coercion/Opt.hs - compiler/GHC/Core/DataCon.hs - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Core/Opt/LiberateCase.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Opt/Simplify/Env.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/Core/Opt/Simplify/Utils.hs - compiler/GHC/Core/Opt/SpecConstr.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Core/Opt/WorkWrap.hs - compiler/GHC/Core/SimpleOpt.hs - + compiler/GHC/Core/SimpleOpt.hs-boot - compiler/GHC/Core/Unfold.hs - compiler/GHC/Core/Unfold.hs-boot - + compiler/GHC/Core/Unfold/Make.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/Data/OrdList.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/CodeOutput.hs - + compiler/GHC/Driver/Config.hs - compiler/GHC/Driver/Finder.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Make.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebb3f815dc84adfefb0198ebc6dc12ec7bbc147f...25132940adf410cfe8ee59bfeb9d0c5cc6625f2a -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ebb3f815dc84adfefb0198ebc6dc12ec7bbc147f...25132940adf410cfe8ee59bfeb9d0c5cc6625f2a You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 09:39:24 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 11 Sep 2020 05:39:24 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 8 commits: keepAlive primop Message-ID: <5f5b45cc282b8_80b3f8434fcad5811551767@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: 9a7b28d1 by GHC GitLab CI at 2020-09-11T09:39:10+00:00 keepAlive primop - - - - - 5cdc673b by Ben Gamari at 2020-09-11T09:39:10+00:00 base: Use keepAlive# in alloca, et al. - - - - - 06e1f579 by GHC GitLab CI at 2020-09-11T09:39:10+00:00 Simplify: Factor out runRW rule - - - - - c7d1145c by GHC GitLab CI at 2020-09-11T09:39:10+00:00 Simplify - - - - - 0411ca07 by GHC GitLab CI at 2020-09-11T09:39:10+00:00 hadrian: Don't include -fdiagnostics-color in argument hash Otherwise the input hash will vary with whether colors are requested, which changed with `isatty`. Fixes #17983. - - - - - cabaf393 by Ben Gamari at 2020-09-11T09:39:10+00:00 base: Use keepAlive# in withForeignPtr - - - - - 26afcf3c by GHC GitLab CI at 2020-09-11T09:39:10+00:00 base: Make ForeignPtrContents of ForeignPtr strict As mentioned in #17290, there are strong benefits to the `ForeignPtrContents` field of `ForeignPtr` being strict. In particular, when looking at the reproducer for #17746, I noticed that the `ForeignPtrContents` was being allocated on every call to `withForeignPtr` just to be `touch#`'d'. This is a pretty large overhead for something like `withForeignPtr` that should be free. This required updating the `bytestring` submodule to avoid a bottoming `ForeignPtrContents` in `Data.ByteString.Internal` Fixes #17290. - - - - - ecbbfe8a by GHC GitLab CI at 2020-09-11T09:39:10+00:00 Clarify types of splitFunTy - - - - - 12 changed files: - compiler/GHC/Builtin/primops.txt.pp - compiler/GHC/Core/Opt/Simplify.hs - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/StgToCmm/Prim.hs - hadrian/src/Settings/Builders/Ghc.hs - hadrian/src/Target.hs - libraries/base/Foreign/ForeignPtr/Imp.hs - libraries/base/Foreign/Marshal/Alloc.hs - libraries/base/GHC/ForeignPtr.hs - libraries/bytestring Changes: ===================================== compiler/GHC/Builtin/primops.txt.pp ===================================== @@ -3320,6 +3320,20 @@ primop NumSparks "numSparks#" GenPrimOp has_side_effects = True out_of_line = True + +------------------------------------------------------------------------ +section "Controlling object lifetime" + {Ensuring that objects don't die a premature death.} +------------------------------------------------------------------------ + +-- See Note [keepAlive# magic] in GHC.CoreToStg.Prep. +primop KeepAliveOp "keepAlive#" GenPrimOp + o -> State# RealWorld -> (State# RealWorld -> p) -> p + { TODO. } + with + strictness = { \ _arity -> mkClosedStrictSig [topDmd, topDmd, strictApply1Dmd] topDiv } + + ------------------------------------------------------------------------ section "Tag to enum stuff" {Convert back and forth between values of enumerated types ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -68,7 +68,7 @@ import GHC.Utils.Misc import GHC.Utils.Error import GHC.Unit.Module ( moduleName, pprModuleName ) import GHC.Core.Multiplicity -import GHC.Builtin.PrimOps ( PrimOp (SeqOp) ) +import GHC.Builtin.PrimOps ( PrimOp (SeqOp, KeepAliveOp) ) {- @@ -1975,29 +1975,9 @@ rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_c = rebuildCall env (addTyArgTo info arg_ty hole_ty) cont ---------- The runRW# rule. Do this after absorbing all arguments ------ --- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep. --- --- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o --- K[ runRW# rr ty body ] --> runRW rr' ty' (\s. K[ body s ]) -rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) - (ApplyToVal { sc_arg = arg, sc_env = arg_se - , sc_cont = cont, sc_hole_ty = fun_ty }) - | fun_id `hasKey` runRWKey - , not (contIsStop cont) -- Don't fiddle around if the continuation is boring - , [ TyArg {}, TyArg {} ] <- rev_args - = do { s <- newId (fsLit "s") Many realWorldStatePrimTy - ; let (m,_,_) = splitFunTy fun_ty - env' = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s] - ty' = contResultType cont - cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s - , sc_env = env', sc_cont = cont - , sc_hole_ty = mkVisFunTy m realWorldStatePrimTy ty' } - -- cont' applies to s, then K - ; body' <- simplExprC env' arg cont' - ; let arg' = Lam s body' - rr' = getRuntimeRep ty' - call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg ty', arg'] - ; return (emptyFloats env, call') } +rebuildCall env arg_info cont + | Just do_it <- rebuildContOpCall env arg_info cont + = do_it rebuildCall env fun_info (ApplyToVal { sc_arg = arg, sc_env = arg_se @@ -2034,6 +2014,89 @@ rebuildCall env fun_info rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont = rebuild env (argInfoExpr fun rev_args) cont +-- | Simplifications of runRW# and keepAlive# +rebuildContOpCall :: SimplEnv -> ArgInfo -> SimplCont -> Maybe (SimplM (SimplFloats, OutExpr)) +rebuildContOpCall _env _arg_info cont + | contIsStop cont -- Don't fiddle around if the continuation is boring + = Nothing + +-- See Note [Simplification of runRW#] in GHC.CoreToSTG.Prep. +-- +-- N.B. runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). +-- (State# RealWorld -> o) -> o +-- +-- K[ runRW# rr ty body ] +-- ~> +-- runRW rr' ty' (\s. K[ body s ]) +rebuildContOpCall + env + (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) + (ApplyToVal { sc_arg = arg, sc_env = arg_se + , sc_cont = cont, sc_hole_ty = fun_ty }) + | fun_id `hasKey` runRWKey + , [ TyArg {}, TyArg {} ] <- rev_args + = Just $ + do { s <- newId (fsLit "s") Many realWorldStatePrimTy + ; let (m,_,_) = splitFunTy fun_ty + env' = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s] + ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' + cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s + , sc_env = env', sc_cont = cont + , sc_hole_ty = k'_ty } + -- cont' applies to s, then K + ; body' <- simplExprC env' arg cont' + ; let arg' = Lam s body' + rr' = getRuntimeRep ty' + call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg ty', arg'] + ; return (emptyFloats env, call') } + +-- See Note [Simplification of keepAlive#] in GHC.CoreToStg.Prep. +-- +-- K[keepAlive# @a_rep @a @r_rep @r x s k] +-- ~> +-- keepAlive# @a_rep @a @r_rep @r x s K[k] +rebuildContOpCall + env + (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) + (ApplyToVal { sc_arg = k, sc_env = k_se + , sc_cont = cont, sc_hole_ty = fun_ty }) + | Just KeepAliveOp <- isPrimOpId_maybe fun_id + , [ ValArg {as_arg=s0} + , ValArg {as_arg=x} + , TyArg {} -- res_ty + , TyArg {} -- res_rep + , TyArg {as_arg_ty=arg_ty} + , TyArg {as_arg_ty=arg_rep} + ] <- rev_args + , False + = Just $ + do { --let (m,_,_) = splitFunTy fun_ty + let m = Many + ; s <- newId (fsLit "s") m realWorldStatePrimTy + ; let k_env = (k_se `setInScopeFromE` env) `addNewInScopeIds` [s] + ty' = contResultType cont + k'_ty = mkVisFunTy m realWorldStatePrimTy ty' + k_cont = ApplyToVal { sc_dup = Simplified, sc_arg = Var s + , sc_env = k_env, sc_cont = cont + , sc_hole_ty = k'_ty } + ; k' <- simplExprC k_env k k_cont + ; let env' = zapSubstEnv env + ; s0' <- simplExpr env' s0 + ; x' <- simplExpr env' x + ; arg_rep' <- simplType env' arg_rep + ; arg_ty' <- simplType env' arg_ty + ; let call' = mkApps (Var fun_id) + [ mkTyArg arg_rep', mkTyArg arg_ty' + , mkTyArg (getRuntimeRep ty'), mkTyArg ty' + , x' + , s0' + , Lam s k' + ] + ; return (emptyFloats env, call') } + +rebuildContOpCall _ _ _ = Nothing + {- Note [Trying rewrite rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider an application (f e1 e2 e3) where the e1,e2,e3 are not yet ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -1120,14 +1120,15 @@ In the compiler we maintain the invariant that all saturated applications of See #11714. -} -splitFunTy :: Type -> (Type, Type, Type) --- ^ Attempts to extract the argument and result types from a type, and --- panics if that is not possible. See also 'splitFunTy_maybe' +splitFunTy :: Type -> (Mult, Type, Type) +-- ^ Attempts to extract the multiplicity, argument and result types from a +-- type, and panics if that is not possible. See also 'splitFunTy_maybe' splitFunTy = expectJust "splitFunTy" . splitFunTy_maybe {-# INLINE splitFunTy_maybe #-} -splitFunTy_maybe :: Type -> Maybe (Type, Type, Type) --- ^ Attempts to extract the argument and result types from a type +splitFunTy_maybe :: Type -> Maybe (Mult, Type, Type) +-- ^ Attempts to extract the multiplicity, argument and result types from a +-- type. splitFunTy_maybe ty | FunTy _ w arg res <- coreFullView ty = Just (w, arg, res) | otherwise = Nothing ===================================== compiler/GHC/Core/Utils.hs ===================================== @@ -1644,6 +1644,8 @@ app_ok primop_ok fun args -> False -- for the special cases for SeqOp and DataToTagOp | DataToTagOp <- op -> False + | KeepAliveOp <- op + -> False | otherwise -> primop_ok op -- Check the primop itself ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -26,7 +26,8 @@ import GHC.Core.Opt.OccurAnal import GHC.Driver.Types import GHC.Driver.Ppr import GHC.Builtin.Names -import GHC.Types.Id.Make ( realWorldPrimId ) +import GHC.Builtin.Types.Prim ( realWorldStatePrimTy ) +import GHC.Types.Id.Make ( realWorldPrimId, mkPrimOpId ) import GHC.Core.Utils import GHC.Core.Opt.Arity import GHC.Core.FVs @@ -46,6 +47,7 @@ import GHC.Types.Var.Env import GHC.Types.Id import GHC.Types.Id.Info import GHC.Builtin.Types +import GHC.Builtin.PrimOps import GHC.Core.DataCon import GHC.Types.Basic import GHC.Unit @@ -775,6 +777,38 @@ cpeApp top_env expr -- rather than the far superior "f x y". Test case is par01. = let (terminal, args', depth') = collect_args arg in cpe_app env terminal (args' ++ args) (depth + depth' - 1) + + cpe_app env + (Var f) + args + n + | Just KeepAliveOp <- isPrimOpId_maybe f + , CpeApp (Type arg_rep) + : CpeApp (Type arg_ty) + : CpeApp (Type _result_rep) + : CpeApp (Type result_ty) + : CpeApp arg + : CpeApp s0 + : CpeApp k + : rest <- pprTrace "cpe_app keepAlive#" (ppr args) args + = do { pprTraceM "cpe_app(keepAlive#)" (ppr n) + ; y <- newVar result_ty + ; s2 <- newVar realWorldStatePrimTy + ; -- beta reduce if possible + ; (floats, k') <- case k of + Lam s body -> cpe_app (extendCorePrepEnvExpr env s s0) body rest (n-2) + _ -> cpe_app env k (CpeApp s0 : rest) (n-1) + ; let touchId = mkPrimOpId TouchOp + expr = Case k' y result_ty [(DEFAULT, [], rhs)] + rhs = let scrut = mkApps (Var touchId) [Type arg_rep, Type arg_ty, arg, Var realWorldPrimId] + in Case scrut s2 result_ty [(DEFAULT, [], Var y)] + ; pprTraceM "cpe_app(keepAlive)" (ppr expr) + ; (floats', expr') <- cpeBody env expr + ; return (floats `appendFloats` floats', expr') + } + | Just KeepAliveOp <- isPrimOpId_maybe f + = panic "invalid keepAlive# application" + cpe_app env (Var f) (CpeApp _runtimeRep at Type{} : CpeApp _type at Type{} : CpeApp arg : rest) n | f `hasKey` runRWKey -- N.B. While it may appear that n == 1 in the case of runRW# @@ -1064,10 +1098,26 @@ Breaking our desired invariant. Ultimately we decided to simply accept that the continuation may not be a manifest lambda. +Note [Simplification of keepAlive#] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +The keepAlive# primop benefits from a similar optimisation to that described in +Note [Simplification of runRW#] above. Specifically, we transform: + + K[keepAlive# @a_rep @a @r_rep @r x s k] + ~> + keepAlive# @a_rep @a @r_rep @r x s K[k] + +The reasons are similar to those described in Note [Simplification of runRW#]. + +-} + + -- --------------------------------------------------------------------------- -- CpeArg: produces a result satisfying CpeArg -- --------------------------------------------------------------------------- +{- Note [ANF-ising literal string arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -1518,6 +1518,8 @@ emitPrimOp dflags primop = case primop of TraceMarkerOp -> alwaysExternal SetThreadAllocationCounter -> alwaysExternal + KeepAliveOp -> panic "keepAlive# should have been eliminated in CorePrep" + where profile = targetProfile dflags platform = profilePlatform profile ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -35,6 +35,9 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do hasDynamic = elem dynamic ways mconcat [ arg "-Wall" , not useColor ? builder (Ghc CompileHs) ? + -- N.B. Target.trackArgument ignores this argument from the + -- input hash to avoid superfluous recompilation, avoiding + -- #18672. arg "-fdiagnostics-color=never" , (hasVanilla && hasDynamic) ? builder (Ghc CompileHs) ? platformSupportsSharedLibs ? way vanilla ? ===================================== hadrian/src/Target.hs ===================================== @@ -21,11 +21,12 @@ type Target = H.Target Context Builder trackArgument :: Target -> String -> Bool trackArgument target arg = case builder target of Make _ -> not $ threadArg arg - Ghc _ _ -> not $ verbosityArg arg + Ghc _ _ -> not $ verbosityArg arg || diagnosticsColorArg arg Cabal _ _ -> not $ verbosityArg arg || cabal_configure_ignore arg _ -> True where threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="] verbosityArg s = dropWhileEnd isDigit s == "-v" + diagnosticsColorArg s = "-fdiagnostics-color=" `isPrefixOf` s -- N.B. #18672 cabal_configure_ignore s = s `elem` [ "--configure-option=--quiet", "--configure-option=--disable-option-checking" ] ===================================== libraries/base/Foreign/ForeignPtr/Imp.hs ===================================== @@ -66,31 +66,6 @@ newForeignPtr finalizer p addForeignPtrFinalizer finalizer fObj return fObj -withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b --- ^This is a way to look at the pointer living inside a --- foreign object. This function takes a function which is --- applied to that pointer. The resulting 'IO' action is then --- executed. The foreign object is kept alive at least during --- the whole action, even if it is not used directly --- inside. Note that it is not safe to return the pointer from --- the action and use it after the action completes. All uses --- of the pointer should be inside the --- 'withForeignPtr' bracket. The reason for --- this unsafeness is the same as for --- 'unsafeForeignPtrToPtr' below: the finalizer --- may run earlier than expected, because the compiler can only --- track usage of the 'ForeignPtr' object, not --- a 'Ptr' object made from it. --- --- This function is normally used for marshalling data to --- or from the object pointed to by the --- 'ForeignPtr', using the operations from the --- 'Storable' class. -withForeignPtr fo io - = do r <- io (unsafeForeignPtrToPtr fo) - touchForeignPtr fo - return r - -- | This variant of 'newForeignPtr' adds a finalizer that expects an -- environment in addition to the finalized pointer. The environment -- that will be passed to the finalizer is fixed by the second argument to ===================================== libraries/base/Foreign/Marshal/Alloc.hs ===================================== @@ -116,19 +116,6 @@ alloca :: forall a b . Storable a => (Ptr a -> IO b) -> IO b alloca = allocaBytesAligned (sizeOf (undefined :: a)) (alignment (undefined :: a)) --- Note [NOINLINE for touch#] --- ~~~~~~~~~~~~~~~~~~~~~~~~~~ --- Both allocaBytes and allocaBytesAligned use the touch#, which is notoriously --- fragile in the presence of simplification (see #14346). In particular, the --- simplifier may drop the continuation containing the touch# if it can prove --- that the action passed to allocaBytes will not return. The hack introduced to --- fix this for 8.2.2 is to mark allocaBytes as NOINLINE, ensuring that the --- simplifier can't see the divergence. --- --- These can be removed once #14375 is fixed, which suggests that we instead do --- away with touch# in favor of a primitive that will capture the scoping left --- implicit in the case of touch#. - -- |@'allocaBytes' n f@ executes the computation @f@, passing as argument -- a pointer to a temporarily allocated block of memory of @n@ bytes. -- The block of memory is sufficiently aligned for any of the basic @@ -142,13 +129,9 @@ allocaBytes (I# size) action = IO $ \ s0 -> case newPinnedByteArray# size s0 of { (# s1, mbarr# #) -> case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) -> let addr = Ptr (byteArrayContents# barr#) in - case action addr of { IO action' -> - case action' s2 of { (# s3, r #) -> - case touch# barr# s3 of { s4 -> - (# s4, r #) - }}}}} --- See Note [NOINLINE for touch#] -{-# NOINLINE allocaBytes #-} + case action addr of { IO action' -> + keepAlive# barr# s2 action' + }}} allocaBytesAligned :: Int -> Int -> (Ptr a -> IO b) -> IO b allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> @@ -156,12 +139,8 @@ allocaBytesAligned (I# size) (I# align) action = IO $ \ s0 -> case unsafeFreezeByteArray# mbarr# s1 of { (# s2, barr# #) -> let addr = Ptr (byteArrayContents# barr#) in case action addr of { IO action' -> - case action' s2 of { (# s3, r #) -> - case touch# barr# s3 of { s4 -> - (# s4, r #) - }}}}} --- See Note [NOINLINE for touch#] -{-# NOINLINE allocaBytesAligned #-} + keepAlive# barr# s2 action' + }}} -- |Resize a memory area that was allocated with 'malloc' or 'mallocBytes' -- to the size needed to store values of type @b at . The returned pointer ===================================== libraries/base/GHC/ForeignPtr.hs ===================================== @@ -46,6 +46,7 @@ module GHC.ForeignPtr castForeignPtr, plusForeignPtr, -- * Finalization + withForeignPtr, touchForeignPtr, finalizeForeignPtr -- * Commentary @@ -79,7 +80,7 @@ import Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) -- type argument of 'ForeignPtr' should normally be an instance of -- class 'Storable'. -- -data ForeignPtr a = ForeignPtr Addr# ForeignPtrContents +data ForeignPtr a = ForeignPtr Addr# !ForeignPtrContents -- The Addr# in the ForeignPtr object is intentionally stored -- separately from the finalizer. The primary aim of the -- representation is to make withForeignPtr efficient; in fact, @@ -503,6 +504,31 @@ newForeignPtr_ (Ptr obj) = do r <- newIORef NoFinalizers return (ForeignPtr obj (PlainForeignPtr r)) +withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b +-- ^This is a way to look at the pointer living inside a +-- foreign object. This function takes a function which is +-- applied to that pointer. The resulting 'IO' action is then +-- executed. The foreign object is kept alive at least during +-- the whole action, even if it is not used directly +-- inside. Note that it is not safe to return the pointer from +-- the action and use it after the action completes. All uses +-- of the pointer should be inside the +-- 'withForeignPtr' bracket. The reason for +-- this unsafeness is the same as for +-- 'unsafeForeignPtrToPtr' below: the finalizer +-- may run earlier than expected, because the compiler can only +-- track usage of the 'ForeignPtr' object, not +-- a 'Ptr' object made from it. +-- +-- This function is normally used for marshalling data to +-- or from the object pointed to by the +-- 'ForeignPtr', using the operations from the +-- 'Storable' class. +withForeignPtr fo@(ForeignPtr _ r) f = IO $ \s -> + case f (unsafeForeignPtrToPtr fo) of + IO action# -> keepAlive# r s action# + + touchForeignPtr :: ForeignPtr a -> IO () -- ^This function ensures that the foreign object in -- question is alive at the given place in the sequence of IO ===================================== libraries/bytestring ===================================== @@ -1 +1 @@ -Subproject commit e6cb01e2ec0bfdd19298418c85f220925a9fa307 +Subproject commit cff1ad3422ed463cf92ea996b276da9156200bbf View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be85911a5946ad341e1cca1684655619bec15339...ecbbfe8a5516989b57c11356b32ab91aa9b49ddb -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/be85911a5946ad341e1cca1684655619bec15339...ecbbfe8a5516989b57c11356b32ab91aa9b49ddb You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 10:23:14 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 11 Sep 2020 06:23:14 -0400 Subject: [Git][ghc/ghc][wip/initializers] 6 commits: gitlab-ci: Bump Docker images Message-ID: <5f5b5012c3947_80b3f8486feb13c1155834@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/initializers at Glasgow Haskell Compiler / GHC Commits: 5aae5b32 by Ben Gamari at 2020-09-09T18:31:40-04:00 gitlab-ci: Bump Docker images We now generate our Docker images via Dhall definitions, as described in ghc/ci-images!52. Additionally, we are far more careful about where tools come from, using the ALEX, HAPPY, HSCOLOR, and GHC environment variables (set in the Dockerfiles) to find bootstrapping tools. - - - - - 4ce9fe88 by Ben Gamari at 2020-09-09T18:31:40-04:00 hadrian: Fix leakage of GHC in PATH into build Previously hadrian would use GHC on PATH when configuring packages (or fail if there is no such GHC). Fix this. Unfortunately this runs into another bug in Cabal which we workaround. - - - - - 291a15dd by Ben Gamari at 2020-09-09T18:31:40-04:00 utils: Bump cabal-version of hp2ps and unlit - - - - - 4798caa0 by David Himmelstrup at 2020-09-09T18:32:16-04:00 rts comment: RTS_TICKY_SYMBOLS moved from rts/Linker.c to rts/RtsSymbols.c - - - - - d05194e4 by Ben Gamari at 2020-09-11T06:22:56-04:00 rts: Refactor foreign export tracking This avoids calling `libc` in the initializers which are responsible for registering foreign exports. We believe this should avoid the corruption observed in #18548. See Note [Tracking foreign exports] in rts/ForeignExports.c for an overview of the new scheme. - - - - - ff8d9013 by Ben Gamari at 2020-09-11T06:23:03-04:00 rts: Refactor unloading of foreign export StablePtrs Previously we would allocate a linked list cell for each foreign export. Now we can avoid this by taking advantage of the fact that they are already broken into groups. - - - - - 19 changed files: - .gitlab-ci.yml - .gitlab/ci.sh - compiler/GHC/HsToCore/Foreign/Decl.hs - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/src/Hadrian/Oracles/Cabal/Rules.hs - includes/Rts.h - + includes/rts/ForeignExports.h - includes/stg/Ticky.h - + rts/ForeignExports.c - + rts/ForeignExports.h - rts/Linker.c - rts/LinkerInternals.h - rts/RtsStartup.c - rts/RtsSymbols.c - rts/rts.cabal.in - testsuite/tests/module/mod184.stderr - utils/hp2ps/hp2ps.cabal - utils/unlit/unlit.cabal Changes: ===================================== .gitlab-ci.yml ===================================== @@ -2,7 +2,7 @@ variables: GIT_SSL_NO_VERIFY: "1" # Commit of ghc/ci-images repository from which to pull Docker images - DOCKER_REV: b65e1145d7c0a62c3533904a88dac14f56fb371b + DOCKER_REV: e1cdfaea745989faa266f09c1d6c4c981aa34dc6 # Sequential version number capturing the versions of all tools fetched by # .gitlab/ci.sh. @@ -119,7 +119,7 @@ lint-testsuite: stage: lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb9:$DOCKER_REV" script: - - make -Ctestsuite list_broken TEST_HC=ghc + - make -Ctestsuite list_broken TEST_HC=$GHC dependencies: [] tags: - lint @@ -259,7 +259,7 @@ hadrian-ghc-in-ghci: - x86_64-linux script: - cabal update - - cd hadrian; cabal new-build --project-file=ci.project; cd .. + - cd hadrian; cabal new-build --with-compiler=$GHC --project-file=ci.project; cd .. - git clean -xdf && git submodule foreach git clean -xdf - .gitlab/ci.sh setup - if [[ -d ./cabal-cache ]]; then cp -R ./.cabal-cache ~/.cabal-cache; fi @@ -461,66 +461,66 @@ validate-x86_64-darwin: - toolchain ################################# -# aarch64-linux-deb9 +# aarch64-linux-deb10 ################################# -.build-aarch64-linux-deb9: +.build-aarch64-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/aarch64-linux-deb10:$DOCKER_REV" allow_failure: true variables: - TEST_ENV: "aarch64-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb9.tar.xz" + TEST_ENV: "aarch64-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-aarch64-linux-deb10.tar.xz" cache: - key: linux-aarch64-deb9 + key: linux-aarch64-deb10 tags: - aarch64-linux -validate-aarch64-linux-deb9: - extends: .build-aarch64-linux-deb9 +validate-aarch64-linux-deb10: + extends: .build-aarch64-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-aarch64-linux-deb9: +nightly-aarch64-linux-deb10: <<: *nightly - extends: .build-aarch64-linux-deb9 + extends: .build-aarch64-linux-deb10 variables: TEST_TYPE: slowtest ################################# -# armv7-linux-deb9 +# armv7-linux-deb10 ################################# -.build-armv7-linux-deb9: +.build-armv7-linux-deb10: extends: .validate-linux stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb9:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/armv7-linux-deb10:$DOCKER_REV" # Due to linker issues allow_failure: true variables: - TEST_ENV: "armv7-linux-deb9" - BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb9.tar.xz" + TEST_ENV: "armv7-linux-deb10" + BIN_DIST_PREP_TAR_COMP: "ghc-armv7-linux-deb10.tar.xz" CONFIGURE_ARGS: "--host=armv7-linux-gnueabihf --build=armv7-linux-gnueabihf --target=armv7-linux-gnueabihf" # N.B. We disable ld.lld explicitly here because it appears to fail # non-deterministically on ARMv7. See #18280. LD: "ld.gold" GccUseLdOpt: "-fuse-ld=gold" cache: - key: linux-armv7-deb9 + key: linux-armv7-deb10 tags: - armv7-linux -validate-armv7-linux-deb9: - extends: .build-armv7-linux-deb9 +validate-armv7-linux-deb10: + extends: .build-armv7-linux-deb10 artifacts: when: always expire_in: 2 week -nightly-armv7-linux-deb9: +nightly-armv7-linux-deb10: <<: *nightly - extends: .build-armv7-linux-deb9 + extends: .build-armv7-linux-deb10 variables: TEST_TYPE: slowtest @@ -734,7 +734,7 @@ release-x86_64-linux-deb8: .build-x86_64-linux-alpine-hadrian: extends: .validate-linux-hadrian stage: full-build - image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine:$DOCKER_REV" + image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$DOCKER_REV" # There are currently a few failing tests allow_failure: true variables: @@ -1082,8 +1082,8 @@ perf-nofib: make install popd rm -Rf tmp - - export BOOT_HC=$(which ghc) - - cabal update; cabal install -w $BOOT_HC regex-compat + - export BOOT_HC=$GHC + - cabal update; cabal install -w "$BOOT_HC" --lib regex-compat - export PATH=$root/bin:$PATH - make -C nofib boot mode=fast -j$CPUS - "make -C nofib EXTRA_RUNTEST_OPTS='-cachegrind +RTS -V0 -RTS' NoFibRuns=1 mode=fast -j$CPUS 2>&1 | tee nofib.log" ===================================== .gitlab/ci.sh ===================================== @@ -152,22 +152,26 @@ function show_tool() { function set_toolchain_paths() { needs_toolchain=1 case "$(uname)" in - Linux) needs_toolchain="" ;; + Linux) needs_toolchain="0" ;; *) ;; esac - if [[ -n "$needs_toolchain" ]]; then + if [[ "$needs_toolchain" = 1 ]]; then # These are populated by setup_toolchain GHC="$toolchain/bin/ghc$exe" CABAL="$toolchain/bin/cabal$exe" HAPPY="$toolchain/bin/happy$exe" ALEX="$toolchain/bin/alex$exe" else - GHC="$(which ghc)" - CABAL="/usr/local/bin/cabal" - HAPPY="$HOME/.cabal/bin/happy" - ALEX="$HOME/.cabal/bin/alex" + # These are generally set by the Docker image but + # we provide these handy fallbacks in case the + # script isn't run from within a GHC CI docker image. + if [ -z "$GHC" ]; then GHC="$(which ghc)"; fi + if [ -z "$CABAL" ]; then GHC="$(which cabal)"; fi + if [ -z "$HAPPY" ]; then GHC="$(which happy)"; fi + if [ -z "$ALEX" ]; then GHC="$(which alex)"; fi fi + export GHC export CABAL export HAPPY @@ -204,12 +208,12 @@ function setup() { } function fetch_ghc() { - local v="$GHC_VERSION" - if [[ -z "$v" ]]; then - fail "GHC_VERSION is not set" - fi - if [ ! -e "$GHC" ]; then + local v="$GHC_VERSION" + if [[ -z "$v" ]]; then + fail "neither GHC nor GHC_VERSION are not set" + fi + start_section "fetch GHC" url="https://downloads.haskell.org/~ghc/${GHC_VERSION}/ghc-${GHC_VERSION}-${boot_triple}.tar.xz" info "Fetching GHC binary distribution from $url..." @@ -233,12 +237,12 @@ function fetch_ghc() { } function fetch_cabal() { - local v="$CABAL_INSTALL_VERSION" - if [[ -z "$v" ]]; then - fail "CABAL_INSTALL_VERSION is not set" - fi - if [ ! -e "$CABAL" ]; then + local v="$CABAL_INSTALL_VERSION" + if [[ -z "$v" ]]; then + fail "neither CABAL nor CABAL_INSTALL_VERSION are not set" + fi + start_section "fetch GHC" case "$(uname)" in # N.B. Windows uses zip whereas all others use .tar.xz @@ -279,7 +283,11 @@ function fetch_cabal() { function setup_toolchain() { fetch_ghc fetch_cabal - cabal_install="$CABAL v2-install --index-state=$hackage_index_state --installdir=$toolchain/bin" + + cabal_install="$CABAL v2-install \ + --with-compiler=$GHC \ + --index-state=$hackage_index_state --installdir=$toolchain/bin" + # Avoid symlinks on Windows case "$(uname)" in MSYS_*|MINGW*) cabal_install="$cabal_install --install-method=copy" ;; ===================================== compiler/GHC/HsToCore/Foreign/Decl.hs ===================================== @@ -91,15 +91,16 @@ dsForeigns' :: [LForeignDecl GhcTc] dsForeigns' [] = return (NoStubs, nilOL) dsForeigns' fos = do + mod <- getModule fives <- mapM do_ldecl fos let (hs, cs, idss, bindss) = unzip4 fives fe_ids = concat idss - fe_init_code = map foreignExportInitialiser fe_ids + fe_init_code = foreignExportsInitialiser mod fe_ids -- return (ForeignStubs (vcat hs) - (vcat cs $$ vcat fe_init_code), + (vcat cs $$ fe_init_code), foldr (appOL . toOL) nilOL bindss) where do_ldecl (L loc decl) = putSrcSpanDs loc (do_decl decl) @@ -700,8 +701,8 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] -foreignExportInitialiser :: Id -> SDoc -foreignExportInitialiser hs_fn = +foreignExportsInitialiser :: Module -> [Id] -> SDoc +foreignExportsInitialiser mod hs_fns = -- Initialise foreign exports by registering a stable pointer from an -- __attribute__((constructor)) function. -- The alternative is to do this from stginit functions generated in @@ -710,14 +711,24 @@ foreignExportInitialiser hs_fn = -- all modules that are imported directly or indirectly are actually used by -- the program. -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL) + -- + -- See Note [Tracking foreign exports] in rts/ForeignExports.c vcat - [ text "static void stginit_export_" <> ppr hs_fn - <> text "() __attribute__((constructor));" - , text "static void stginit_export_" <> ppr hs_fn <> text "()" - , braces (text "foreignExportStablePtr" - <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure") - <> semi) + [ text "static struct ForeignExportsList" <+> list_symbol <+> equals + <+> braces (text ".exports = " <+> export_list) <> semi + , text "static void " <> ctor_symbol <> text "(void)" + <+> text " __attribute__((constructor));" + , text "static void " <> ctor_symbol <> text "()" + , braces (text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi) ] + where + mod_str = moduleStableString mod + ctor_symbol = text "stginit_export_" <> ppr mod_str + list_symbol = text "stg_exports_" <> text mod_str + export_list = braces $ pprWithCommas closure_ptr hs_fns + + closure_ptr :: Id -> SDoc + closure_ptr fn = text "(StgPtr) &" <> ppr fn <> text "_closure" mkHObj :: Type -> SDoc ===================================== hadrian/build-cabal ===================================== @@ -1,8 +1,9 @@ #!/usr/bin/env bash -CABAL=cabal -CABFLAGS=("--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) -( ${GHC:-ghc} --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") +CABAL="${CABAL:-cabal}" +GHC="${GHC:-ghc}" +CABFLAGS=("--with-compiler=$GHC" "--disable-documentation" "--disable-profiling" "--disable-library-profiling" $CABFLAGS) +( $GHC --info | grep -s '("Support SMP","YES")' > /dev/null ) || CABFLAGS+=("--constraint=hadrian -threaded") # It is currently more robust to pass Cabal an absolute path to the project file. PROJ="$PWD/hadrian/cabal.project" ===================================== hadrian/build-cabal.bat ===================================== @@ -4,8 +4,12 @@ if "%CABAL%"=="" ( set CABAL=cabal ) +if "%GHC%"=="" ( + set GHC=ghc +) + if "%CABFLAGS%"=="" ( - set CABFLAGS=--disable-documentation --disable-profiling --disable-library-profiling + set CABFLAGS=--with-compiler=%GHC% --disable-documentation --disable-profiling --disable-library-profiling ) rem It is currently more robust to pass Cabal an absolute path to the project file. ===================================== hadrian/src/Hadrian/Oracles/Cabal/Rules.hs ===================================== @@ -15,6 +15,7 @@ import Control.Monad import Data.Maybe import Development.Shake import Distribution.Simple.GHC +import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Db import Distribution.Verbosity @@ -58,8 +59,13 @@ cabalOracle = do ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..." -- Configure the package with the GHC corresponding to the given stage hcPath <- builderPath (Ghc CompileHs stage) + let progDb = userSpecifyPath "ghc" hcPath + $ addKnownProgram ghcProgram emptyProgramDb (compiler, maybePlatform, _pkgdb) <- liftIO $ - configure silent (Just hcPath) Nothing emptyProgramDb + -- N.B. the hcPath parameter of `configure` is broken when given an + -- empty ProgramDb. To work around this we manually construct an + -- appropriate ProgramDb. + configure silent Nothing Nothing progDb let platform = fromMaybe (error msg) maybePlatform msg = "PackageConfiguration oracle: cannot detect platform" return $ PackageConfiguration (compiler, platform) ===================================== includes/Rts.h ===================================== @@ -212,6 +212,9 @@ void _assertFail(const char *filename, unsigned int linenum) #include "rts/storage/GC.h" #include "rts/NonMoving.h" +/* Foreign exports */ +#include "rts/ForeignExports.h" + /* Other RTS external APIs */ #include "rts/Parallel.h" #include "rts/Signals.h" ===================================== includes/rts/ForeignExports.h ===================================== @@ -0,0 +1,38 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1995-2009 + * + * Interface to the RTS's foreign export tracking code. + * + * Do not #include this file directly: #include "Rts.h" instead. + * + * To understand the structure of the RTS headers, see the wiki: + * https://gitlab.haskell.org/ghc/ghc/wikis/commentary/source-tree/includes + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +struct _ObjectCode; + +/* N.B. See Note [Tracking foreign exports] in + * rts/ForeignExports.c. */ +struct ForeignExportsList { + /* a link field for linking these together into lists. + */ + struct ForeignExportsList *next; + /* the length of ->exports */ + int n_entries; + /* if the RTS linker loaded the module, + * to which ObjectCode these exports belong. */ + struct _ObjectCode *oc; + /* if the RTS linker loaded the module, + * this points to an array of length ->n_entries + * recording the StablePtr for each export. */ + StgStablePtr **stable_ptrs; + /* the exported closures. of length ->exports. */ + StgPtr exports[]; +}; + +void registerForeignExports(struct ForeignExportsList *exports); + ===================================== includes/stg/Ticky.h ===================================== @@ -19,7 +19,7 @@ /* Here are all the counter declarations: */ /* If you change this list, make the corresponding change - in RTS_TICKY_SYMBOLS in rts/Linker.c */ + in RTS_TICKY_SYMBOLS in rts/RtsSymbols.c */ /* These two are explicitly declared in rts/Ticky.c, and hence should not be extern'd except when using this header ===================================== rts/ForeignExports.c ===================================== @@ -0,0 +1,130 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#include "Rts.h" +#include "RtsUtils.h" +#include "ForeignExports.h" + +/* protected by linker_mutex after start-up */ +static struct ForeignExportsList *pending = NULL; +static ObjectCode *loading_obj = NULL; + +/* + * Note [Tracking foreign exports] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * + * Foreign exports are garbage collection roots. That is, things (e.g. CAFs) + * depended upon by a module's `foreign export`s need to be kept alive for as + * long an module is loaded. To ensure this we create a stable pointer to each + * `foreign export`'d closure. This works as follows: + * + * 1. The compiler (namely GHC.HsToCore.Foreign.Decl.foreignExports) + * inserts a C-stub into each module containing a `foreign export`. This + * stub contains two things: + * + * - A `ForeignExportsList` listing all of the exported closures, and + * + * - An initializer which calls `registerForeignExports` with a reference to + * the `ForeignExportsList`. + * + * 2. When the module's object code is loaded, its initializer is called by the + * linker (this might be the system's dynamic linker or GHC's own static + * linker). `registerForeignExports` then places the module's + * `ForeignExportsList` on `pending` list. + * + * 3. When loading has finished (e.g. during RTS initialization or at the end + * of `Linker.c:ocTryLoad`) `processForeignExports` is called. Here we + * traverse the `pending` list and create a `StablePtr` for each export + * therein. + * + * The reason for this two-step process is that we are very restricted in what + * we can do in an initializer function. For instance, we cannot necessarily + * call `malloc` since the `libc`'s own initializer may not have run yet. + * For instance, doing exactly this resulted in #18548. + * + * Another consideration here is that the linker needs to know which + * `StablePtr`s belong to each `ObjectCode` so it can free them when the module is + * unloaded. For this reason, the linker informs us when it is loading an + * object by calling `foreignExportsLoadingObject` and + * `foreignExportsFinishedLoadingObject`. We take note of the `ObjectCode*` we + * are loading in `loading_obj` such that we can associate the `ForeignExportsList` with + * the `ObjectCode` in `processForeignExports`. We then record each of the + * StablePtrs we create in the ->stable_ptrs array of ForeignExportsList so + * they can be enumerated during unloading. + * + */ + +void registerForeignExports(struct ForeignExportsList *exports) +{ + ASSERT(exports->next == NULL); + ASSERT(exports->oc == NULL); + exports->next = pending; + exports->oc = loading_obj; + pending = exports; +} + +/* ----------------------------------------------------------------------------- + Create a StablePtr for a foreign export. This is normally called by + a C function with __attribute__((constructor)), which is generated + by GHC and linked into the module. + + If the object code is being loaded dynamically, then we remember + which StablePtrs were allocated by the constructors and free them + again in unloadObj(). + -------------------------------------------------------------------------- */ + +void foreignExportsLoadingObject(ObjectCode *oc) +{ + ASSERT(loading_obj == NULL); + loading_obj = oc; +} + +void foreignExportsFinishedLoadingObject() +{ + ASSERT(loading_obj != NULL); + loading_obj = NULL; + processForeignExports(); +} + +/* Caller must own linker_mutex so that we can safely modify + * oc->stable_ptrs. */ +void processForeignExports() +{ + while (pending) { + ForeignExportsList *cur = pending; + pending = cur->next; + + /* sanity check */ + ASSERT(cur->stable_ptrs == NULL); + + /* N.B. We only need to populate the ->stable_ptrs + * array if the object might later be unloaded. + */ + if (cur->oc != NULL) { + cur->stable_ptrs = + stgMallocBytes(sizeof(StgStablePtr*) * cur->n_entries, + "foreignExportStablePtr"); + + for (int i=0; i < cur->n_entries; i++) { + StgStablePtr *sptr = getStablePtr(cur->exports[i]); + + if (cur->oc != NULL) { + cur->stable_ptrs[i] = sptr; + } + } + cur->next = cur->oc->stable_ptrs; + cur->oc->stable_ptrs = cur; + } else { + /* can't be unloaded, don't bother populating + * ->stable_ptrs array. */ + for (int i=0; i < cur->n_entries; i++) { + getStablePtr(cur->exports[i]); + } + } + } +} ===================================== rts/ForeignExports.h ===================================== @@ -0,0 +1,20 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team 2020 + * + * Management of foreign exports. + * + * ---------------------------------------------------------------------------*/ + +#pragma once + +#include "BeginPrivate.h" +#include "Rts.h" +#include "LinkerInternals.h" + +void foreignExportsLoadingObject(ObjectCode *oc); +void foreignExportsFinishedLoadingObject(void); +void processForeignExports(void); + +#include "EndPrivate.h" + ===================================== rts/Linker.c ===================================== @@ -26,6 +26,7 @@ #include "RtsSymbols.h" #include "RtsSymbolInfo.h" #include "Profiling.h" +#include "ForeignExports.h" #include "sm/OSMem.h" #include "linker/M32Alloc.h" #include "linker/CacheFlush.h" @@ -968,37 +969,6 @@ SymbolAddr* lookupSymbol( SymbolName* lbl ) return r; } -/* ----------------------------------------------------------------------------- - Create a StablePtr for a foreign export. This is normally called by - a C function with __attribute__((constructor)), which is generated - by GHC and linked into the module. - - If the object code is being loaded dynamically, then we remember - which StablePtrs were allocated by the constructors and free them - again in unloadObj(). - -------------------------------------------------------------------------- */ - -static ObjectCode *loading_obj = NULL; - -StgStablePtr foreignExportStablePtr (StgPtr p) -{ - ForeignExportStablePtr *fe_sptr; - StgStablePtr *sptr; - - sptr = getStablePtr(p); - - if (loading_obj != NULL) { - fe_sptr = stgMallocBytes(sizeof(ForeignExportStablePtr), - "foreignExportStablePtr"); - fe_sptr->stable_ptr = sptr; - fe_sptr->next = loading_obj->stable_ptrs; - loading_obj->stable_ptrs = fe_sptr; - } - - return sptr; -} - - /* ----------------------------------------------------------------------------- * Debugging aid: look in GHCi's object symbol tables for symbols * within DELTA bytes of the specified address, and show their names. @@ -1269,12 +1239,16 @@ static void freeOcStablePtrs (ObjectCode *oc) { // Release any StablePtrs that were created when this // object module was initialized. - ForeignExportStablePtr *fe_ptr, *next; + ForeignExportsList *exports, *next; - for (fe_ptr = oc->stable_ptrs; fe_ptr != NULL; fe_ptr = next) { - next = fe_ptr->next; - freeStablePtr(fe_ptr->stable_ptr); - stgFree(fe_ptr); + for (exports = oc->foreign_exports; exports != NULL; exports = next) { + next = exports->next; + for (int i = 0; i < exports->n_entries) { + freeStablePtr(exports->stable_ptrs[i]); + } + stgFree(exports->stable_ptrs); + exports->stable_ptrs = NULL; + exports->next = NULL; } oc->stable_ptrs = NULL; } @@ -1793,7 +1767,8 @@ int ocTryLoad (ObjectCode* oc) { IF_DEBUG(linker, debugBelch("ocTryLoad: ocRunInit start\n")); - loading_obj = oc; // tells foreignExportStablePtr what to do + // See Note [Tracking foreign exports] in ForeignExports.c + foreignExportsLoadingObject(oc); #if defined(OBJFORMAT_ELF) r = ocRunInit_ELF ( oc ); #elif defined(OBJFORMAT_PEi386) @@ -1803,7 +1778,7 @@ int ocTryLoad (ObjectCode* oc) { #else barf("ocTryLoad: initializers not implemented on this platform"); #endif - loading_obj = NULL; + foreignExportsFinishedLoadingObject(); if (!r) { return r; } ===================================== rts/LinkerInternals.h ===================================== @@ -135,17 +135,6 @@ typedef struct _Segment { int n_sections; } Segment; -/* - * We must keep track of the StablePtrs that are created for foreign - * exports by constructor functions when the module is loaded, so that - * we can free them again when the module is unloaded. If we don't do - * this, then the StablePtr will keep the module alive indefinitely. - */ -typedef struct ForeignExportStablePtr_ { - StgStablePtr stable_ptr; - struct ForeignExportStablePtr_ *next; -} ForeignExportStablePtr; - #if defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH) #define NEED_SYMBOL_EXTRAS 1 #endif @@ -240,7 +229,8 @@ typedef struct _ObjectCode { char* bssBegin; char* bssEnd; - ForeignExportStablePtr *stable_ptrs; + /* a list of all ForeignExportsLists owned by this object */ + ForeignExportsList *foreign_exports; /* Holds the list of symbols in the .o file which require extra information.*/ ===================================== rts/RtsStartup.c ===================================== @@ -20,6 +20,7 @@ #include "STM.h" /* initSTM */ #include "RtsSignals.h" #include "Weak.h" +#include "ForeignExports.h" /* processForeignExports */ #include "Ticky.h" #include "StgRun.h" #include "Prelude.h" /* fixupRTStoPreludeRefs */ @@ -339,7 +340,13 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config) getStablePtr((StgPtr)processRemoteCompletion_closure); #endif - // Initialize the top-level handler system + /* + * process any foreign exports which were registered while loading the + * image + * */ + processForeignExports(); + + /* initialize the top-level handler system */ initTopHandler(); /* initialise the shared Typeable store */ ===================================== rts/RtsSymbols.c ===================================== @@ -652,7 +652,7 @@ SymI_HasProto(freeFullProgArgv) \ SymI_HasProto(getProcessElapsedTime) \ SymI_HasProto(getStablePtr) \ - SymI_HasProto(foreignExportStablePtr) \ + SymI_HasProto(registerForeignExports) \ SymI_HasProto(hs_init) \ SymI_HasProto(hs_init_with_rtsopts) \ SymI_HasProto(hs_init_ghc) \ ===================================== rts/rts.cabal.in ===================================== @@ -140,6 +140,7 @@ library rts/EventLogWriter.h rts/FileLock.h rts/Flags.h + rts/ForeignExports.h rts/GetTime.h rts/Globals.h rts/Hpc.h @@ -412,6 +413,7 @@ library ClosureFlags.c Disassembler.c FileLock.c + ForeignExports.c Globals.c Hash.c Heap.c ===================================== testsuite/tests/module/mod184.stderr ===================================== @@ -1,3 +1,4 @@ + mod184.hs:6:8: warning: [-Wprepositive-qualified-module] Found ‘qualified’ in prepositive position Suggested fix: place ‘qualified’ after the module name instead. ===================================== utils/hp2ps/hp2ps.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: hp2ps Version: 0.1 Copyright: XXX ===================================== utils/unlit/unlit.cabal ===================================== @@ -1,4 +1,4 @@ -cabal-version: 2.1 +cabal-version: 2.4 Name: unlit Version: 0.1 Copyright: XXX View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2d0faba923909d2dc18342c310807e571ff5bf3...ff8d901367e11d66455a87ad16c50700ff408ce2 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d2d0faba923909d2dc18342c310807e571ff5bf3...ff8d901367e11d66455a87ad16c50700ff408ce2 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 11:22:44 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 11 Sep 2020 07:22:44 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 2 commits: Lint Message-ID: <5f5b5e04bbce4_80b3f849249065011560220@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: 479ac999 by GHC GitLab CI at 2020-09-11T11:12:50+00:00 Lint - - - - - dcc48ecd by GHC GitLab CI at 2020-09-11T11:22:24+00:00 Simplify - - - - - 2 changed files: - compiler/GHC/Core/Lint.hs - compiler/GHC/Core/Opt/Simplify.hs Changes: ===================================== compiler/GHC/Core/Lint.hs ===================================== @@ -33,6 +33,7 @@ import GHC.Core.Opt.Monad import GHC.Data.Bag import GHC.Types.Literal import GHC.Core.DataCon +import GHC.Builtin.PrimOps ( PrimOp(KeepAliveOp) ) import GHC.Builtin.Types.Prim import GHC.Builtin.Types ( multiplicityTy ) import GHC.Tc.Utils.TcType ( isFloatingTy, isTyFamFree ) @@ -910,17 +911,33 @@ lintCoreExpr e@(Let (Rec pairs) body) bndrs = map fst pairs lintCoreExpr e@(App _ _) - | Var fun <- fun - , fun `hasKey` runRWKey + -- Special linting for keepAlive# + | Var fun_id <- fun + , Just KeepAliveOp <- isPrimOpId_maybe fun_id + , arg_rep : arg_ty : k_rep : k_ty : arg : s : k : rest <- args + = do { (fun_ty1, ue1) <- lintCoreArgs (idType fun_id, zeroUE) [arg_rep, arg_ty, k_rep, k_ty, arg, s] + -- See Note [Linting of runRW#] + ; let lintRunRWCont :: CoreArg -> LintM (LintedType, UsageEnv) + lintRunRWCont expr@(Lam _ _) = do + lintJoinLams 1 (Just fun_id) expr + lintRunRWCont other = markAllJoinsBad $ lintCoreExpr other + -- TODO: Look through ticks? + ; (arg2_ty, ue2) <- lintRunRWCont k + ; app_ty <- lintValApp k fun_ty1 arg2_ty ue1 ue2 + ; lintCoreArgs app_ty rest } + + -- Special linting for runRW# + | Var fun_id <- fun + , fun_id `hasKey` runRWKey -- N.B. we may have an over-saturated application of the form: -- runRW (\s -> \x -> ...) y , arg_ty1 : arg_ty2 : arg3 : rest <- args - = do { fun_pair1 <- lintCoreArg (idType fun, zeroUE) arg_ty1 + = do { fun_pair1 <- lintCoreArg (idType fun_id, zeroUE) arg_ty1 ; (fun_ty2, ue2) <- lintCoreArg fun_pair1 arg_ty2 -- See Note [Linting of runRW#] ; let lintRunRWCont :: CoreArg -> LintM (LintedType, UsageEnv) lintRunRWCont expr@(Lam _ _) = do - lintJoinLams 1 (Just fun) expr + lintJoinLams 1 (Just fun_id) expr lintRunRWCont other = markAllJoinsBad $ lintCoreExpr other -- TODO: Look through ticks? ; (arg3_ty, ue3) <- lintRunRWCont arg3 ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -2069,7 +2069,6 @@ rebuildContOpCall , TyArg {as_arg_ty=arg_ty} , TyArg {as_arg_ty=arg_rep} ] <- rev_args - , False = Just $ do { --let (m,_,_) = splitFunTy fun_ty let m = Many View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecbbfe8a5516989b57c11356b32ab91aa9b49ddb...dcc48ecdcd4cd01d289593f0831e8db8ebdb697c -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ecbbfe8a5516989b57c11356b32ab91aa9b49ddb...dcc48ecdcd4cd01d289593f0831e8db8ebdb697c You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 13:00:28 2020 From: gitlab at gitlab.haskell.org (Ben Gamari) Date: Fri, 11 Sep 2020 09:00:28 -0400 Subject: [Git][ghc/ghc][wip/keepAlive-optionB] 2 commits: testsuite: A few minor perf notes fixes Message-ID: <5f5b74ecc85f5_80bb2d598c115644a9@gitlab.haskell.org.mail> Ben Gamari pushed to branch wip/keepAlive-optionB at Glasgow Haskell Compiler / GHC Commits: 4a883917 by GHC GitLab CI at 2020-09-11T12:41:34+00:00 testsuite: A few minor perf notes fixes - - - - - ad5a0272 by GHC GitLab CI at 2020-09-11T13:00:19+00:00 simplify - - - - - 3 changed files: - compiler/GHC/Core/Opt/Simplify.hs - testsuite/driver/perf_notes.py - testsuite/driver/runtests.py Changes: ===================================== compiler/GHC/Core/Opt/Simplify.hs ===================================== @@ -2060,7 +2060,7 @@ rebuildContOpCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args }) (ApplyToVal { sc_arg = k, sc_env = k_se - , sc_cont = cont, sc_hole_ty = fun_ty }) + , sc_cont = cont }) | Just KeepAliveOp <- isPrimOpId_maybe fun_id , [ ValArg {as_arg=s0} , ValArg {as_arg=x} ===================================== testsuite/driver/perf_notes.py ===================================== @@ -311,7 +311,7 @@ def append_perf_stat(stats: List[PerfStat], max_tries: int=5 ) -> bool: # Append to git note - print('Appending ' + str(len(stats)) + ' stats to git notes.') + print('Appending %d stats to git note namespace %s.' % (len(stats), namespace)) stats_str = format_perf_stat(stats) def try_append(): try: ===================================== testsuite/driver/runtests.py ===================================== @@ -512,10 +512,11 @@ else: # Write perf stats if any exist or if a metrics file is specified. stats_metrics = [stat for (_, stat, __) in t.metrics] # type: List[PerfStat] if hasMetricsFile: - print('Appending ' + str(len(stats_metrics)) + ' stats to file: ' + config.metrics_file) + print('Appending %d stats to file: %s' % (len(stats_metrics), config.metrics_file)) with open(config.metrics_file, 'a') as f: f.write("\n" + Perf.format_perf_stat(stats_metrics)) - elif inside_git_repo() and any(stats_metrics): + + if inside_git_repo() and any(stats_metrics): if is_worktree_dirty(): print() print(str_warn('Performance Metrics NOT Saved') + \ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dcc48ecdcd4cd01d289593f0831e8db8ebdb697c...ad5a0272c76ddd89e1c9ed335cb5bed460121d19 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dcc48ecdcd4cd01d289593f0831e8db8ebdb697c...ad5a0272c76ddd89e1c9ed335cb5bed460121d19 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 13:59:24 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Sep 2020 09:59:24 -0400 Subject: [Git][ghc/ghc][master] 2 commits: .gitignore *.hiedb files Message-ID: <5f5b82bccdf2a_80b3f848acb50b811576595@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 6abe4a1c by Sebastian Graf at 2020-09-10T17:02:00+02:00 .gitignore *.hiedb files - - - - - 3777be14 by Sebastian Graf at 2020-09-10T17:03:12+02:00 PmCheck: Handle ⊥ and strict fields correctly (#18341) In #18341, we discovered an incorrect digression from Lower Your Guards. This MR changes what's necessary to support properly fixing #18341. In particular, bottomness constraints are now properly tracked in the oracle/inhabitation testing, as an additional field `vi_bot :: Maybe Bool` in `VarInfo`. That in turn allows us to model newtypes as advertised in the Appendix of LYG and fix #17725. Proper handling of ⊥ also fixes #17977 (once again) and fixes #18670. For some reason I couldn't follow, this also fixes #18273. I also added a couple of regression tests that were missing. Most of them were already fixed before. In summary, this patch fixes #18341, #17725, #18273, #17977 and #18670. Metric Decrease: T12227 - - - - - 28 changed files: - .gitignore - compiler/GHC/Core/DataCon.hs - compiler/GHC/Data/Bag.hs - compiler/GHC/HsToCore/Binds.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/GuardedRHSs.hs - compiler/GHC/HsToCore/Match.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Ppr.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/HsToCore/PmCheck/Types.hs-boot - compiler/GHC/Tc/Types.hs - + testsuite/tests/pmcheck/should_compile/T10183.hs - testsuite/tests/pmcheck/should_compile/T17340.stderr - + testsuite/tests/pmcheck/should_compile/T17378.hs - + testsuite/tests/pmcheck/should_compile/T17725.hs - + testsuite/tests/pmcheck/should_compile/T17725.stderr - + testsuite/tests/pmcheck/should_compile/T17729.hs - + testsuite/tests/pmcheck/should_compile/T17729.stderr - + testsuite/tests/pmcheck/should_compile/T17977.stderr - + testsuite/tests/pmcheck/should_compile/T18273.hs - + testsuite/tests/pmcheck/should_compile/T18341.hs - + testsuite/tests/pmcheck/should_compile/T18341.stderr - + testsuite/tests/pmcheck/should_compile/T18670.hs - + testsuite/tests/pmcheck/should_compile/T18670.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== .gitignore ===================================== @@ -237,5 +237,8 @@ ghc.nix/ # Visual Studio Code .vscode +# Tooling - ghcide +*.hiedb + # clangd .clangd ===================================== compiler/GHC/Core/DataCon.hs ===================================== @@ -54,7 +54,7 @@ module GHC.Core.DataCon ( isNullarySrcDataCon, isNullaryRepDataCon, isTupleDataCon, isBoxedTupleDataCon, isUnboxedTupleDataCon, isUnboxedSumDataCon, - isVanillaDataCon, classDataCon, dataConCannotMatch, + isVanillaDataCon, isNewDataCon, classDataCon, dataConCannotMatch, dataConUserTyVarsArePermuted, isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked, specialPromotedDc, @@ -1481,6 +1481,10 @@ isUnboxedSumDataCon (MkData {dcRepTyCon = tc}) = isUnboxedSumTyCon tc isVanillaDataCon :: DataCon -> Bool isVanillaDataCon dc = dcVanilla dc +-- | Is this the 'DataCon' of a newtype? +isNewDataCon :: DataCon -> Bool +isNewDataCon dc = isNewTyCon (dataConTyCon dc) + -- | Should this DataCon be allowed in a type even without -XDataKinds? -- Currently, only Lifted & Unlifted specialPromotedDc :: DataCon -> Bool ===================================== compiler/GHC/Data/Bag.hs ===================================== @@ -6,7 +6,7 @@ Bag: an unordered collection with duplicates -} -{-# LANGUAGE ScopedTypeVariables, CPP, DeriveFunctor #-} +{-# LANGUAGE ScopedTypeVariables, CPP, DeriveFunctor, TypeFamilies #-} module GHC.Data.Bag ( Bag, -- abstract type @@ -27,9 +27,9 @@ module GHC.Data.Bag ( import GHC.Prelude +import GHC.Exts ( IsList(..) ) import GHC.Utils.Outputable import GHC.Utils.Misc - import GHC.Utils.Monad import Control.Monad import Data.Data @@ -333,3 +333,8 @@ instance Traversable Bag where traverse f (UnitBag x) = UnitBag <$> f x traverse f (TwoBags b1 b2) = TwoBags <$> traverse f b1 <*> traverse f b2 traverse f (ListBag xs) = ListBag <$> traverse f xs + +instance IsList (Bag a) where + type Item (Bag a) = a + fromList = listToBag + toList = bagToList ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -185,8 +185,8 @@ dsHsBind dflags b@(FunBind { fun_id = L loc fun dsHsBind dflags (PatBind { pat_lhs = pat, pat_rhs = grhss , pat_ext = ty , pat_ticks = (rhs_tick, var_ticks) }) - = do { rhss_deltas <- covCheckGRHSs PatBindGuards grhss - ; body_expr <- dsGuarded grhss ty rhss_deltas + = do { rhss_nablas <- covCheckGRHSs PatBindGuards grhss + ; body_expr <- dsGuarded grhss ty rhss_nablas ; let body' = mkOptTickBox rhs_tick body_expr pat' = decideBangHood dflags pat ; (force_var,sel_binds) <- mkSelectorBinds var_ticks pat body' ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -215,8 +215,8 @@ dsUnliftedBind (PatBind {pat_lhs = pat, pat_rhs = grhss , pat_ext = ty }) body = -- let C x# y# = rhs in body -- ==> case rhs of C x# y# -> body - do { match_deltas <- covCheckGRHSs PatBindGuards grhss - ; rhs <- dsGuarded grhss ty match_deltas + do { match_nablas <- covCheckGRHSs PatBindGuards grhss + ; rhs <- dsGuarded grhss ty match_nablas ; let upat = unLoc pat eqn = EqnInfo { eqn_pats = [upat], eqn_orig = FromSource, @@ -486,8 +486,8 @@ dsExpr (HsMultiIf res_ty alts) | otherwise = do { let grhss = GRHSs noExtField alts (noLoc emptyLocalBinds) - ; rhss_deltas <- covCheckGRHSs IfAlt grhss - ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_deltas + ; rhss_nablas <- covCheckGRHSs IfAlt grhss + ; match_result <- dsGRHSs IfAlt grhss res_ty rhss_nablas ; error_expr <- mkErrorExpr ; extractMatchResult match_result error_expr } where ===================================== compiler/GHC/HsToCore/GuardedRHSs.hs ===================================== @@ -25,7 +25,7 @@ import GHC.Core.Utils (bindNonRec) import GHC.HsToCore.Monad import GHC.HsToCore.Utils -import GHC.HsToCore.PmCheck.Types ( Deltas ) +import GHC.HsToCore.PmCheck.Types ( Nablas ) import GHC.Core.Type ( Type ) import GHC.Utils.Misc import GHC.Types.SrcLoc @@ -48,9 +48,9 @@ producing an expression with a runtime error in the corner case if necessary. The type argument gives the type of the @ei at . -} -dsGuarded :: GRHSs GhcTc (LHsExpr GhcTc) -> Type -> NonEmpty Deltas -> DsM CoreExpr -dsGuarded grhss rhs_ty rhss_deltas = do - match_result <- dsGRHSs PatBindRhs grhss rhs_ty rhss_deltas +dsGuarded :: GRHSs GhcTc (LHsExpr GhcTc) -> Type -> NonEmpty Nablas -> DsM CoreExpr +dsGuarded grhss rhs_ty rhss_nablas = do + match_result <- dsGRHSs PatBindRhs grhss rhs_ty rhss_nablas error_expr <- mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty empty extractMatchResult match_result error_expr @@ -59,28 +59,28 @@ dsGuarded grhss rhs_ty rhss_deltas = do dsGRHSs :: HsMatchContext GhcRn -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ Guarded RHSs -> Type -- ^ Type of RHS - -> NonEmpty Deltas -- ^ Refined pattern match checking + -> NonEmpty Nablas -- ^ Refined pattern match checking -- models, one for the pattern part and -- one for each GRHS. -> DsM (MatchResult CoreExpr) -dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty rhss_deltas +dsGRHSs hs_ctx (GRHSs _ grhss binds) rhs_ty rhss_nablas = ASSERT( notNull grhss ) - do { match_results <- ASSERT( length grhss == length rhss_deltas ) - zipWithM (dsGRHS hs_ctx rhs_ty) (toList rhss_deltas) grhss - ; deltas <- getPmDeltas - -- We need to remember the Deltas from the particular match context we + do { match_results <- ASSERT( length grhss == length rhss_nablas ) + zipWithM (dsGRHS hs_ctx rhs_ty) (toList rhss_nablas) grhss + ; nablas <- getPmNablas + -- We need to remember the Nablas from the particular match context we -- are in, which might be different to when dsLocalBinds is actually -- called. - ; let ds_binds = updPmDeltas deltas . dsLocalBinds binds + ; let ds_binds = updPmNablas nablas . dsLocalBinds binds match_result1 = foldr1 combineMatchResults match_results match_result2 = adjustMatchResultDs ds_binds match_result1 -- NB: nested dsLet inside matchResult ; return match_result2 } -dsGRHS :: HsMatchContext GhcRn -> Type -> Deltas -> LGRHS GhcTc (LHsExpr GhcTc) +dsGRHS :: HsMatchContext GhcRn -> Type -> Nablas -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM (MatchResult CoreExpr) -dsGRHS hs_ctx rhs_ty rhs_deltas (L _ (GRHS _ guards rhs)) - = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs_deltas rhs rhs_ty +dsGRHS hs_ctx rhs_ty rhs_nablas (L _ (GRHS _ guards rhs)) + = matchGuards (map unLoc guards) (PatGuard hs_ctx) rhs_nablas rhs rhs_ty {- ************************************************************************ @@ -92,7 +92,7 @@ dsGRHS hs_ctx rhs_ty rhs_deltas (L _ (GRHS _ guards rhs)) matchGuards :: [GuardStmt GhcTc] -- Guard -> HsStmtContext GhcRn -- Context - -> Deltas -- The RHS's covered set for PmCheck + -> Nablas -- The RHS's covered set for PmCheck -> LHsExpr GhcTc -- RHS -> Type -- Type of RHS of guard -> DsM (MatchResult CoreExpr) @@ -100,8 +100,8 @@ matchGuards :: [GuardStmt GhcTc] -- Guard -- See comments with HsExpr.Stmt re what a BodyStmt means -- Here we must be in a guard context (not do-expression, nor list-comp) -matchGuards [] _ deltas rhs _ - = do { core_rhs <- updPmDeltas deltas (dsLExpr rhs) +matchGuards [] _ nablas rhs _ + = do { core_rhs <- updPmNablas nablas (dsLExpr rhs) ; return (cantFailMatchResult core_rhs) } -- BodyStmts must be guards @@ -111,31 +111,31 @@ matchGuards [] _ deltas rhs _ -- NB: The success of this clause depends on the typechecker not -- wrapping the 'otherwise' in empty HsTyApp or HsWrap constructors -- If it does, you'll get bogus overlap warnings -matchGuards (BodyStmt _ e _ _ : stmts) ctx deltas rhs rhs_ty +matchGuards (BodyStmt _ e _ _ : stmts) ctx nablas rhs rhs_ty | Just addTicks <- isTrueLHsExpr e = do - match_result <- matchGuards stmts ctx deltas rhs rhs_ty + match_result <- matchGuards stmts ctx nablas rhs rhs_ty return (adjustMatchResultDs addTicks match_result) -matchGuards (BodyStmt _ expr _ _ : stmts) ctx deltas rhs rhs_ty = do - match_result <- matchGuards stmts ctx deltas rhs rhs_ty +matchGuards (BodyStmt _ expr _ _ : stmts) ctx nablas rhs rhs_ty = do + match_result <- matchGuards stmts ctx nablas rhs rhs_ty pred_expr <- dsLExpr expr return (mkGuardedMatchResult pred_expr match_result) -matchGuards (LetStmt _ binds : stmts) ctx deltas rhs rhs_ty = do - match_result <- matchGuards stmts ctx deltas rhs rhs_ty +matchGuards (LetStmt _ binds : stmts) ctx nablas rhs rhs_ty = do + match_result <- matchGuards stmts ctx nablas rhs rhs_ty return (adjustMatchResultDs (dsLocalBinds binds) match_result) -- NB the dsLet occurs inside the match_result -- Reason: dsLet takes the body expression as its argument -- so we can't desugar the bindings without the -- body expression in hand -matchGuards (BindStmt _ pat bind_rhs : stmts) ctx deltas rhs rhs_ty = do +matchGuards (BindStmt _ pat bind_rhs : stmts) ctx nablas rhs rhs_ty = do let upat = unLoc pat match_var <- selectMatchVar Many upat -- We only allow unrestricted patterns in guard, hence the `Many` -- above. It isn't clear what linear patterns would mean, maybe we will -- figure it out in the future. - match_result <- matchGuards stmts ctx deltas rhs rhs_ty + match_result <- matchGuards stmts ctx nablas rhs rhs_ty core_rhs <- dsLExpr bind_rhs match_result' <- matchSinglePatVar match_var (Just core_rhs) (StmtCtxt ctx) pat rhs_ty match_result ===================================== compiler/GHC/HsToCore/Match.hs ===================================== @@ -35,7 +35,7 @@ import GHC.Tc.Utils.Zonk import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad import GHC.HsToCore.PmCheck -import GHC.HsToCore.PmCheck.Types ( Deltas, initDeltas ) +import GHC.HsToCore.PmCheck.Types ( Nablas, initNablas ) import GHC.Core import GHC.Types.Literal import GHC.Core.Utils @@ -766,31 +766,31 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches (hsLMatchPats m)) -- Pattern match check warnings for /this match-group/. - -- @rhss_deltas@ is a flat list of covered Deltas for each RHS. - -- Each Match will split off one Deltas for its RHSs from this. - ; matches_deltas <- if isMatchContextPmChecked dflags origin ctxt + -- @rhss_nablas@ is a flat list of covered Nablas for each RHS. + -- Each Match will split off one Nablas for its RHSs from this. + ; matches_nablas <- if isMatchContextPmChecked dflags origin ctxt then addHsScrutTmCs mb_scr new_vars $ -- See Note [Long-distance information] covCheckMatches (DsMatchContext ctxt locn) new_vars matches - else pure (initDeltasMatches matches) + else pure (initNablasMatches matches) - ; eqns_info <- zipWithM mk_eqn_info matches matches_deltas + ; eqns_info <- zipWithM mk_eqn_info matches matches_nablas ; result_expr <- handleWarnings $ matchEquations ctxt new_vars eqns_info rhs_ty ; return (new_vars, result_expr) } where -- Called once per equation in the match, or alternative in the case - mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Deltas, NonEmpty Deltas) -> DsM EquationInfo - mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_deltas, rhss_deltas) + mk_eqn_info :: LMatch GhcTc (LHsExpr GhcTc) -> (Nablas, NonEmpty Nablas) -> DsM EquationInfo + mk_eqn_info (L _ (Match { m_pats = pats, m_grhss = grhss })) (pat_nablas, rhss_nablas) = do { dflags <- getDynFlags ; let upats = map (unLoc . decideBangHood dflags) pats - -- pat_deltas is the covered set *after* matching the pattern, but - -- before any of the GRHSs. We extend the environment with pat_deltas - -- (via updPmDeltas) so that the where-clause of 'grhss' can profit + -- pat_nablas is the covered set *after* matching the pattern, but + -- before any of the GRHSs. We extend the environment with pat_nablas + -- (via updPmNablas) so that the where-clause of 'grhss' can profit -- from that knowledge (#18533) - ; match_result <- updPmDeltas pat_deltas $ - dsGRHSs ctxt grhss rhs_ty rhss_deltas + ; match_result <- updPmNablas pat_nablas $ + dsGRHSs ctxt grhss rhs_ty rhss_nablas ; return EqnInfo { eqn_pats = upats , eqn_orig = FromSource , eqn_rhs = match_result } } @@ -799,14 +799,14 @@ matchWrapper ctxt mb_scr (MG { mg_alts = L _ matches then discardWarningsDs else id - initDeltasMatches :: [LMatch GhcTc b] -> [(Deltas, NonEmpty Deltas)] - initDeltasMatches ms - = map (\(L _ m) -> (initDeltas, initDeltasGRHSs (m_grhss m))) ms + initNablasMatches :: [LMatch GhcTc b] -> [(Nablas, NonEmpty Nablas)] + initNablasMatches ms + = map (\(L _ m) -> (initNablas, initNablasGRHSs (m_grhss m))) ms - initDeltasGRHSs :: GRHSs GhcTc b -> NonEmpty Deltas - initDeltasGRHSs m = expectJust "GRHSs non-empty" + initNablasGRHSs :: GRHSs GhcTc b -> NonEmpty Nablas + initNablasGRHSs m = expectJust "GRHSs non-empty" $ NEL.nonEmpty - $ replicate (length (grhssGRHSs m)) initDeltas + $ replicate (length (grhssGRHSs m)) initNablas matchEquations :: HsMatchContext GhcRn ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -34,7 +34,7 @@ module GHC.HsToCore.Monad ( DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv, -- Getting and setting pattern match oracle states - getPmDeltas, updPmDeltas, + getPmNablas, updPmNablas, -- Get COMPLETE sets of a TyCon dsGetCompleteMatches, @@ -304,7 +304,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv , dsl_loc = real_span - , dsl_deltas = initDeltas + , dsl_nablas = initNablas } in (gbl_env, lcl_env) @@ -403,14 +403,14 @@ the @SrcSpan@ being carried around. getGhcModeDs :: DsM GhcMode getGhcModeDs = getDynFlags >>= return . ghcMode --- | Get the current pattern match oracle state. See 'dsl_deltas'. -getPmDeltas :: DsM Deltas -getPmDeltas = do { env <- getLclEnv; return (dsl_deltas env) } +-- | Get the current pattern match oracle state. See 'dsl_nablas'. +getPmNablas :: DsM Nablas +getPmNablas = do { env <- getLclEnv; return (dsl_nablas env) } -- | Set the pattern match oracle state within the scope of the given action. --- See 'dsl_deltas'. -updPmDeltas :: Deltas -> DsM a -> DsM a -updPmDeltas deltas = updLclEnv (\env -> env { dsl_deltas = deltas }) +-- See 'dsl_nablas'. +updPmNablas :: Nablas -> DsM a -> DsM a +updPmNablas nablas = updLclEnv (\env -> env { dsl_nablas = nablas }) getSrcSpanDs :: DsM SrcSpan getSrcSpanDs = do { env <- getLclEnv ===================================== compiler/GHC/HsToCore/PmCheck.hs ===================================== @@ -29,14 +29,14 @@ -- a. The set of uncovered values, 'cr_uncov' -- b. And an annotated tree variant (like 'AnnMatch') that captures -- redundancy and inaccessibility information as 'RedSets' annotations --- Basically the UA function from Section 5.1. The Normalised Refinement Types --- Nabla are modeled as 'Deltas' and checked in "GHC.HsToCore.PmCheck.Oracle". +-- Basically the UA function from Section 5.1. The Normalised Refinement +-- Types 'Nablas' are maintained in "GHC.HsToCore.PmCheck.Oracle". -- 3. Collect redundancy information into a 'CIRB' with a function such -- as 'cirbsMatch'. Follows the R function from Figure 6 of the paper. -- 4. Format and report uncovered patterns and redundant equations ('CIRB') -- with 'formatReportWarnings'. Basically job of the G function, plus proper -- pretty printing of the warnings (Section 5.4 of the paper). --- 5. Return 'Deltas' reaching syntactic sub-components for +-- 5. Return 'Nablas' reaching syntactic sub-components for -- Note [Long-distance information]. Collected by functions such as -- 'ldiMatch'. See Section 4.1 of the paper. module GHC.HsToCore.PmCheck ( @@ -70,7 +70,6 @@ import GHC.Utils.Misc import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Core.DataCon -import GHC.Core.TyCon import GHC.Types.Var (EvVar) import GHC.Core.Coercion import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper) @@ -102,21 +101,21 @@ import Data.Coerce -- -- | A non-empty delta that is initialised from the ambient refinement type --- capturing long-distance information, or the trivially habitable 'Deltas' if +-- capturing long-distance information, or the trivially habitable 'Nablas' if -- the former is uninhabited. -- See Note [Recovering from unsatisfiable pattern-matching constraints]. -getLdiDeltas :: DsM Deltas -getLdiDeltas = do - deltas <- getPmDeltas - isInhabited deltas >>= \case - True -> pure deltas - False -> pure initDeltas +getLdiNablas :: DsM Nablas +getLdiNablas = do + nablas <- getPmNablas + isInhabited nablas >>= \case + True -> pure nablas + False -> pure initNablas -- | Check a pattern binding (let, where) for exhaustiveness. covCheckPatBind :: DsMatchContext -> Id -> Pat GhcTc -> DsM () -- See Note [covCheckPatBind only checks PatBindRhs] covCheckPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do - missing <- getLdiDeltas + missing <- getLdiNablas pat_bind <- desugarPatBind loc var p tracePm "covCheckPatBind {" (vcat [ppr ctxt, ppr var, ppr p, ppr pat_bind, ppr missing]) result <- unCA (checkPatBind pat_bind) missing @@ -125,17 +124,17 @@ covCheckPatBind ctxt@(DsMatchContext PatBindRhs loc) var p = do covCheckPatBind _ _ _ = pure () -- | Exhaustive for guard matches, is used for guards in pattern bindings and --- in @MultiIf@ expressions. Returns the 'Deltas' covered by the RHSs. +-- in @MultiIf@ expressions. Returns the 'Nablas' covered by the RHSs. covCheckGRHSs :: HsMatchContext GhcRn -- ^ Match context, for warning messages -> GRHSs GhcTc (LHsExpr GhcTc) -- ^ The GRHSs to check - -> DsM (NonEmpty Deltas) -- ^ Covered 'Deltas' for each RHS, for long + -> DsM (NonEmpty Nablas) -- ^ Covered 'Nablas' for each RHS, for long -- distance info covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do let combined_loc = foldl1 combineSrcSpans (map getLoc grhss) ctxt = DsMatchContext hs_ctxt combined_loc matches <- desugarGRHSs combined_loc empty guards - missing <- getLdiDeltas + missing <- getLdiNablas tracePm "covCheckGRHSs" (hang (vcat [ppr ctxt , text "Guards:"]) 2 @@ -154,7 +153,7 @@ covCheckGRHSs hs_ctxt guards@(GRHSs _ grhss _) = do -- f _ _ = 3 -- clause with a single, un-guarded RHS -- @ -- --- Returns one non-empty 'Deltas' for 1.) each pattern of a 'Match' and 2.) +-- Returns one non-empty 'Nablas' for 1.) each pattern of a 'Match' and 2.) -- each of a 'Match'es 'GRHS' for Note [Long-distance information]. -- -- Special case: When there are /no matches/, then the functionassumes it @@ -164,13 +163,13 @@ covCheckMatches :: DsMatchContext -- ^ Match context, for warnings messages -> [Id] -- ^ Match variables, i.e. x and y above -> [LMatch GhcTc (LHsExpr GhcTc)] -- ^ List of matches - -> DsM [(Deltas, NonEmpty Deltas)] -- ^ One covered 'Deltas' per Match and + -> DsM [(Nablas, NonEmpty Nablas)] -- ^ One covered 'Nablas' per Match and -- GRHS, for long distance info. covCheckMatches ctxt vars matches = do -- We have to force @missing@ before printing out the trace message, -- otherwise we get interleaved output from the solver. This function -- should be strict in @missing@ anyway! - !missing <- getLdiDeltas + !missing <- getLdiNablas tracePm "covCheckMatches {" $ hang (vcat [ppr ctxt, ppr vars, text "Matches:"]) 2 @@ -223,7 +222,7 @@ exception into divergence (@f x = f x@). Semantically, unlike every other case expression, -XEmptyCase is strict in its match var x, which rules out ⊥ as an inhabitant. So we add x /~ ⊥ to the -initial Delta and check if there are any values left to match on. +initial Nabla and check if there are any values left to match on. -} -- @@ -249,8 +248,8 @@ data PmGrd -- bang pattern, in which case we might want to report it as redundant. -- See Note [Dead bang patterns]. | PmBang { - pm_id :: !Id, - pm_loc :: !(Maybe SrcInfo) + pm_id :: !Id, + _pm_loc :: !(Maybe SrcInfo) } -- | @PmLet x expr@ corresponds to a @let x = expr@ guard. This actually @@ -296,15 +295,15 @@ type SrcInfo = Located SDoc -- (later digested into a 'CIRB'). data RedSets = RedSets - { rs_cov :: !Deltas + { rs_cov :: !Nablas -- ^ The /Covered/ set; the set of values reaching a particular program -- point. - , rs_div :: !Deltas + , rs_div :: !Nablas -- ^ The /Diverging/ set; empty if no match can lead to divergence. -- If it wasn't empty, we have to turn redundancy warnings into -- inaccessibility warnings for any subclauses. - , rs_bangs :: !(OrdList (Deltas, SrcInfo)) - -- ^ If any of the 'Deltas' is empty, the corresponding 'SrcInfo' pin-points + , rs_bangs :: !(OrdList (Nablas, SrcInfo)) + -- ^ If any of the 'Nablas' is empty, the corresponding 'SrcInfo' pin-points -- a bang pattern in source that is redundant. See Note [Dead bang patterns]. } @@ -447,7 +446,7 @@ vanillaConGrd scrut con arg_ids = -- For example: -- @mkListGrds "a" "[(x, True <- x),(y, !y)]"@ -- to --- @"[(x:b) <- a, True <- x, (y:c) <- b, seq y True, [] <- c]"@ +-- @"[(x:b) <- a, True <- x, (y:c) <- b, !y, [] <- c]"@ -- where @b@ and @c@ are freshly allocated in @mkListGrds@ and @a@ is the match -- variable. mkListGrds :: Id -> [(Id, GrdVec)] -> DsM GrdVec @@ -631,7 +630,7 @@ desugarListPat x pats = do -- | Desugar a constructor pattern desugarConPatOut :: Id -> ConLike -> [Type] -> [TyVar] - -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdVec + -> [EvVar] -> HsConPatDetails GhcTc -> DsM GrdVec desugarConPatOut x con univ_tys ex_tvs dicts = \case PrefixCon ps -> go_field_pats (zip [0..] ps) InfixCon p1 p2 -> go_field_pats (zip [0..] [p1,p2]) @@ -651,14 +650,14 @@ desugarConPatOut x con univ_tys ex_tvs dicts = \case lbl_to_index lbl = expectJust "lbl_to_index" $ elemIndex lbl orig_lbls go_field_pats tagged_pats = do - -- The fields that appear might not be in the correct order. So first - -- do a PmCon match, then force according to field strictness and then - -- force evaluation of the field patterns in the order given by - -- the first field of @tagged_pats at . + -- The fields that appear might not be in the correct order. So + -- 1. Do the PmCon match + -- 2. Then pattern match on the fields in the order given by the first + -- field of @tagged_pats at . -- See Note [Field match order for RecCon] -- Desugar the mentioned field patterns. We're doing this first to get - -- the Ids for pm_con_args. + -- the Ids for pm_con_args and bring them in order afterwards. let trans_pat (n, pat) = do (var, pvec) <- desugarLPatV pat pure ((n, var), pvec) @@ -672,19 +671,11 @@ desugarConPatOut x con univ_tys ex_tvs dicts = \case arg_ids <- zipWithM get_pat_id [0..] arg_tys let con_grd = PmCon x (PmAltConLike con) ex_tvs dicts arg_ids - -- 2. bang strict fields - let arg_is_banged = map isBanged $ conLikeImplBangs con - noSrcPmBang i = PmBang {pm_id = i, pm_loc = Nothing} - bang_grds = map noSrcPmBang (filterByList arg_is_banged arg_ids) - - -- 3. guards from field selector patterns + -- 2. guards from field selector patterns let arg_grds = concat arg_grdss -- tracePm "ConPatOut" (ppr x $$ ppr con $$ ppr arg_ids) - -- - -- Store the guards in exactly that order - -- 1. 2. 3. - pure (con_grd : bang_grds ++ arg_grds) + pure (con_grd : arg_grds) desugarPatBind :: SrcSpan -> Id -> Pat GhcTc -> DsM (PmPatBind Pre) -- See 'GrdPatBind' for how this simply repurposes GrdGRHS. @@ -772,30 +763,45 @@ desugarBoolGuard e -> pure [vanillaConGrd y trueDataCon []] rhs -> do x <- mkPmId boolTy - pure $ [PmLet x rhs, vanillaConGrd x trueDataCon []] + pure [PmLet x rhs, vanillaConGrd x trueDataCon []] {- Note [Field match order for RecCon] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The order for RecCon field patterns actually determines evaluation order of the pattern match. For example: - data T = T { a :: !Bool, b :: Char, c :: Int } + data T = T { a :: Char, b :: Int } f :: T -> () - f T{ c = 42, b = 'b' } = () + f T{ b = 42, a = 'a' } = () + +Then @f (T (error "a") (error "b"))@ errors out with "b" because it is mentioned +first in the pattern match. -Then - * @f (T (error "a") (error "b") (error "c"))@ errors out with "a" because of - the strict field. - * @f (T True (error "b") (error "c"))@ errors out with "c" because it - is mentioned frist in the pattern match. +This means we can't just desugar the pattern match to +@[T a b <- x, 'a' <- a, 42 <- b]@. Instead we have to force them in the +right order: @[T a b <- x, 42 <- b, 'a' <- a]@. -This means we can't just desugar the pattern match to the PatVec -@[T !_ 'b' 42]@. Instead we have to generate variable matches that have -strictness according to the field declarations and afterwards force them in the -right order. As a result, we get the PatVec @[T !_ b c, 42 <- c, 'b' <- b]@. +Note [Strict fields and fields of unlifted type] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +How do strict fields play into Note [Field match order for RecCon]? Answer: +They don't. Desugaring is entirely unconcerned by strict fields; the forcing +happens *before* pattern matching. But for each strict (or more generally, +unlifted) field @s@ we have to add @s /~ ⊥@ constraints when we check the PmCon +guard in 'checkGrd'. Strict fields are devoid of ⊥ by construction, there's +nothing that a bang pattern would act on. Example from #18341: + + data T = MkT !Int + f :: T -> () + f (MkT _) | False = () -- inaccessible + f (MkT !_) | False = () -- redundant, not only inaccessible! + f _ = () -Of course, when the labels occur in the order they are defined, we can just use -the simpler desugaring. +The second clause desugars to @MkT n <- x, !n at . When coverage checked, the +'PmCon' @MkT n <- x@ refines the set of values that reach the bang pattern with +the constraints @x ~ MkT n, n /~ ⊥@ (this list is computed by 'pmConCts'). +Checking the 'PmBang' @!n@ will then try to add the constraint @n ~ ⊥@ to this +set to get the diverging set, which is found to be empty. Hence the whole +clause is detected as redundant, as expected. Note [Order of guards matters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -847,7 +853,7 @@ data CheckResult a = CheckResult { cr_ret :: !a -- ^ A hole for redundancy info and covered sets. - , cr_uncov :: !Deltas + , cr_uncov :: !Nablas -- ^ The set of uncovered values falling out at the bottom. -- (for -Wincomplete-patterns, but also important state for the algorithm) , cr_approx :: !Precision @@ -865,23 +871,23 @@ instance Outputable a => Outputable (CheckResult a) where ppr_precision Approximate = text "(Approximate)" field name value = text name <+> equals <+> ppr value --- | Lift 'addPmCts' over 'Deltas'. -addPmCtsDeltas :: Deltas -> PmCts -> DsM Deltas -addPmCtsDeltas deltas cts = liftDeltasM (\d -> addPmCts d cts) deltas +-- | Lift 'addPmCts' over 'Nablas'. +addPmCtsNablas :: Nablas -> PmCts -> DsM Nablas +addPmCtsNablas nablas cts = liftNablasM (\d -> addPmCts d cts) nablas --- | 'addPmCtsDeltas' for a single 'PmCt'. -addPmCtDeltas :: Deltas -> PmCt -> DsM Deltas -addPmCtDeltas deltas ct = addPmCtsDeltas deltas (unitBag ct) +-- | 'addPmCtsNablas' for a single 'PmCt'. +addPmCtNablas :: Nablas -> PmCt -> DsM Nablas +addPmCtNablas nablas ct = addPmCtsNablas nablas (unitBag ct) --- | Test if any of the 'Delta's is inhabited. Currently this is pure, because --- we preserve the invariant that there are no uninhabited 'Delta's. But that +-- | Test if any of the 'Nabla's is inhabited. Currently this is pure, because +-- we preserve the invariant that there are no uninhabited 'Nabla's. But that -- could change in the future, for example by implementing this function in -- terms of @notNull <$> provideEvidence 1 ds at . -isInhabited :: Deltas -> DsM Bool -isInhabited (MkDeltas ds) = pure (not (null ds)) +isInhabited :: Nablas -> DsM Bool +isInhabited (MkNablas ds) = pure (not (null ds)) -- | Coverage checking action. Can be composed 'leftToRight' or 'topToBottom'. -newtype CheckAction a = CA { unCA :: Deltas -> DsM (CheckResult a) } +newtype CheckAction a = CA { unCA :: Nablas -> DsM (CheckResult a) } deriving Functor -- | Composes 'CheckAction's top-to-bottom: @@ -923,23 +929,34 @@ leftToRight f (CA left) (CA right) = CA $ \inc -> do , cr_uncov = uncov' , cr_approx = prec' Semi.<> cr_approx l Semi.<> cr_approx r } --- | @throttle limit old new@ returns @old@ if the number of 'Delta's in @new@ --- is exceeding the given @limit@ and the @old@ number of 'Delta's. +-- | @throttle limit old new@ returns @old@ if the number of 'Nabla's in @new@ +-- is exceeding the given @limit@ and the @old@ number of 'Nabla's. -- See Note [Countering exponential blowup]. -throttle :: Int -> Deltas -> Deltas -> (Precision, Deltas) -throttle limit old@(MkDeltas old_ds) new@(MkDeltas new_ds) +throttle :: Int -> Nablas -> Nablas -> (Precision, Nablas) +throttle limit old@(MkNablas old_ds) new@(MkNablas new_ds) --- | pprTrace "PmCheck:throttle" (ppr (length old_ds) <+> ppr (length new_ds) <+> ppr limit) False = undefined | length new_ds > max limit (length old_ds) = (Approximate, old) | otherwise = (Precise, new) --- | Matching on a newtype doesn't force anything. --- See Note [Divergence of Newtype matches] in "GHC.HsToCore.PmCheck.Oracle". -conMatchForces :: PmAltCon -> Bool -conMatchForces (PmAltConLike (RealDataCon dc)) - | isNewTyCon (dataConTyCon dc) = False -conMatchForces _ = True - --- First the functions that correspond to checking LYG primitives: +-- | The 'PmCts' arising from a successful 'PmCon' match @T gammas as ys <- x at . +-- These include +-- +-- * @gammas@: Constraints arising from the bound evidence vars +-- * @y /~ ⊥@ constraints for each unlifted field (including strict fields) +-- @y@ in @ys@ +-- * The constructor constraint itself: @x ~ T as ys at . +-- +-- See Note [Strict fields and fields of unlifted type]. +pmConCts :: Id -> PmAltCon -> [TyVar] -> [EvVar] -> [Id] -> PmCts +pmConCts x con tvs dicts args = gammas `unionBags` unlifted `snocBag` con_ct + where + gammas = listToBag $ map (PmTyCt . evVarPred) dicts + con_ct = PmConCt x con tvs args + unlifted = listToBag [ PmNotBotCt arg + | (arg, bang) <- + zipEqual "pmConCts" args (pmAltConImplBangs con) + , isBanged bang || isUnliftedType (idType arg) + ] checkSequence :: (grdtree -> CheckAction anntree) -> NonEmpty grdtree -> CheckAction (NonEmpty anntree) -- The implementation is pretty similar to @@ -952,31 +969,32 @@ checkGrd :: PmGrd -> CheckAction RedSets checkGrd grd = CA $ \inc -> case grd of -- let x = e: Refine with x ~ e PmLet x e -> do - matched <- addPmCtDeltas inc (PmCoreCt x e) + matched <- addPmCtNablas inc (PmCoreCt x e) + -- tracePm "check:Let" (ppr x <+> char '=' <+> ppr e) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched } , cr_uncov = mempty , cr_approx = Precise } -- Bang x _: Diverge on x ~ ⊥, refine with x /~ ⊥ PmBang x mb_info -> do - div <- addPmCtDeltas inc (PmBotCt x) - matched <- addPmCtDeltas inc (PmNotBotCt x) + div <- addPmCtNablas inc (PmBotCt x) + matched <- addPmCtNablas inc (PmNotBotCt x) -- See Note [Dead bang patterns] -- mb_info = Just info <==> PmBang originates from bang pattern in source let bangs | Just info <- mb_info = unitOL (div, info) | otherwise = NilOL + -- tracePm "check:Bang" (ppr x <+> ppr div) pure CheckResult { cr_ret = RedSets { rs_cov = matched, rs_div = div, rs_bangs = bangs } , cr_uncov = mempty , cr_approx = Precise } - -- Con: Diverge on x ~ ⊥, fall through on x /~ K and refine with x ~ K ys - -- and type info + -- Con: Fall through on x /~ K and refine with x ~ K ys and type info PmCon x con tvs dicts args -> do - div <- if conMatchForces con - then addPmCtDeltas inc (PmBotCt x) + !div <- if isPmAltConMatchStrict con + then addPmCtNablas inc (PmBotCt x) else pure mempty - uncov <- addPmCtDeltas inc (PmNotConCt x con) - matched <- addPmCtsDeltas inc $ - listToBag (PmTyCt . evVarPred <$> dicts) `snocBag` PmConCt x con tvs args - -- tracePm "checkGrd:Con" (ppr inc $$ ppr x $$ ppr con $$ ppr dicts $$ ppr matched) + let con_cts = pmConCts x con tvs dicts args + !matched <- addPmCtsNablas inc con_cts + !uncov <- addPmCtNablas inc (PmNotConCt x con) + -- tracePm "checkGrd:Con" (ppr inc $$ ppr grd $$ ppr con_cts $$ ppr matched) pure CheckResult { cr_ret = emptyRedSets { rs_cov = matched, rs_div = div } , cr_uncov = uncov , cr_approx = Precise } @@ -1010,7 +1028,7 @@ checkGRHS (PmGRHS { pg_grds = grds, pg_rhs = rhs_info }) = checkEmptyCase :: PmEmptyCase -> CheckAction PmEmptyCase checkEmptyCase pe@(PmEmptyCase { pe_var = var }) = CA $ \inc -> do - unc <- addPmCtDeltas inc (PmNotBotCt var) + unc <- addPmCtNablas inc (PmNotBotCt var) pure CheckResult { cr_ret = pe, cr_uncov = unc, cr_approx = mempty } checkPatBind :: (PmPatBind Pre) -> CheckAction (PmPatBind Post) @@ -1020,7 +1038,7 @@ checkPatBind = coerce checkGRHS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Precise pattern match exhaustiveness checking is necessarily exponential in the size of some input programs. We implement a counter-measure in the form of -the -fmax-pmcheck-models flag, limiting the number of Deltas we check against +the -fmax-pmcheck-models flag, limiting the number of Nablas we check against each pattern by a constant. How do we do that? Consider @@ -1029,13 +1047,13 @@ How do we do that? Consider f True True = () And imagine we set our limit to 1 for the sake of the example. The first clause -will be checked against the initial Delta, {}. Doing so will produce an +will be checked against the initial Nabla, {}. Doing so will produce an Uncovered set of size 2, containing the models {x/~True} and {x~True,y/~True}. Also we find the first clause to cover the model {x~True,y~True}. But the Uncovered set we get out of the match is too huge! We somehow have to ensure not to make things worse as they are already, so we continue checking -with a singleton Uncovered set of the initial Delta {}. Why is this +with a singleton Uncovered set of the initial Nabla {}. Why is this sound (wrt. the notion in GADTs Meet Their Match)? Well, it basically amounts to forgetting that we matched against the first clause. The values represented by {} are a superset of those represented by its two refinements {x/~True} and @@ -1062,14 +1080,14 @@ program, so we don't actually get useful information out of that split! -- * Collecting long-distance information -- -ldiMatchGroup :: PmMatchGroup Post -> NonEmpty (Deltas, NonEmpty Deltas) +ldiMatchGroup :: PmMatchGroup Post -> NonEmpty (Nablas, NonEmpty Nablas) ldiMatchGroup (PmMatchGroup matches) = ldiMatch <$> matches -ldiMatch :: PmMatch Post -> (Deltas, NonEmpty Deltas) +ldiMatch :: PmMatch Post -> (Nablas, NonEmpty Nablas) ldiMatch (PmMatch { pm_pats = red, pm_grhss = grhss }) = (rs_cov red, ldiGRHS <$> grhss) -ldiGRHS :: PmGRHS Post -> Deltas +ldiGRHS :: PmGRHS Post -> Nablas ldiGRHS (PmGRHS { pg_grds = red }) = rs_cov red -- @@ -1114,17 +1132,17 @@ addRedundantBangs _red_bangs cirb at CIRB { cirb_cov = NilOL, cirb_inacc = NilOL } addRedundantBangs red_bangs cirb = cirb { cirb_bangs = cirb_bangs cirb Semi.<> red_bangs } --- | Checks the 'Deltas' in a 'RedSets' for inhabitants and returns +-- | Checks the 'Nablas' in a 'RedSets' for inhabitants and returns -- 1. Whether the Covered set was inhabited -- 2. Whether the Diverging set was inhabited --- 3. All source bangs whose 'Deltas' were empty, which means they are +-- 3. All source bangs whose 'Nablas' were empty, which means they are -- redundant. testRedSets :: RedSets -> DsM (Bool, Bool, OrdList SrcInfo) testRedSets RedSets { rs_cov = cov, rs_div = div, rs_bangs = bangs } = do is_covered <- isInhabited cov may_diverge <- isInhabited div - red_bangs <- flip mapMaybeM (fromOL bangs) $ \(deltas, bang) -> do - isInhabited deltas >>= \case + red_bangs <- flip mapMaybeM (fromOL bangs) $ \(nablas, bang) -> do + isInhabited nablas >>= \case True -> pure Nothing False -> pure (Just bang) pure (is_covered, may_diverge, toOL red_bangs) @@ -1233,10 +1251,10 @@ reportWarnings dflags ctx@(DsMatchContext kind loc) vars f (q <+> matchSeparator kind <+> text "...") -- Print several clauses (for uncovered clauses) - pprEqns vars deltas = pprContext False ctx (text "are non-exhaustive") $ \_ -> + pprEqns vars nablas = pprContext False ctx (text "are non-exhaustive") $ \_ -> case vars of -- See #11245 [] -> text "Guards do not cover entire pattern space" - _ -> let us = map (\delta -> pprUncovered delta vars) deltas + _ -> let us = map (\nabla -> pprUncovered nabla vars) nablas in hang (text "Patterns not matched:") 4 (vcat (take maxPatterns us) $$ dots maxPatterns us) @@ -1251,14 +1269,14 @@ reportWarnings dflags ctx@(DsMatchContext kind loc) vars $$ bullet <+> text "Patterns reported as unmatched might actually be matched") , text "Increase the limit or resolve the warnings to suppress this message." ] -getNFirstUncovered :: [Id] -> Int -> Deltas -> DsM [Delta] -getNFirstUncovered vars n (MkDeltas deltas) = go n (bagToList deltas) +getNFirstUncovered :: [Id] -> Int -> Nablas -> DsM [Nabla] +getNFirstUncovered vars n (MkNablas nablas) = go n (bagToList nablas) where go 0 _ = pure [] go _ [] = pure [] - go n (delta:deltas) = do - front <- provideEvidence vars n delta - back <- go (n - length front) deltas + go n (nabla:nablas) = do + front <- provideEvidence vars n nabla + back <- go (n - length front) nablas pure (front ++ back) dots :: Int -> [a] -> SDoc @@ -1383,13 +1401,13 @@ code that we don't want to warn about. -- * Long-distance information -- --- | Locally update 'dsl_deltas' with the given action, but defer evaluation +-- | Locally update 'dsl_nablas' with the given action, but defer evaluation -- with 'unsafeInterleaveM' in order not to do unnecessary work. -locallyExtendPmDeltas :: (Deltas -> DsM Deltas) -> DsM a -> DsM a -locallyExtendPmDeltas ext k = do - deltas <- getLdiDeltas - deltas' <- unsafeInterleaveM $ ext deltas - updPmDeltas deltas' k +locallyExtendPmNablas :: (Nablas -> DsM Nablas) -> DsM a -> DsM a +locallyExtendPmNablas ext k = do + nablas <- getLdiNablas + nablas' <- unsafeInterleaveM $ ext nablas + updPmNablas nablas' k -- | Add in-scope type constraints if the coverage checker might run and then -- run the given action. @@ -1397,7 +1415,7 @@ addTyCs :: Origin -> Bag EvVar -> DsM a -> DsM a addTyCs origin ev_vars m = do dflags <- getDynFlags applyWhen (needToRunPmCheck dflags origin) - (locallyExtendPmDeltas (\deltas -> addPmCtsDeltas deltas (PmTyCt . evVarPred <$> ev_vars))) + (locallyExtendPmNablas (\nablas -> addPmCtsNablas nablas (PmTyCt . evVarPred <$> ev_vars))) m -- | Add equalities for the 'CoreExpr' scrutinee to the local 'DsM' environment @@ -1408,8 +1426,8 @@ addTyCs origin ev_vars m = do addCoreScrutTmCs :: Maybe CoreExpr -> [Id] -> DsM a -> DsM a addCoreScrutTmCs Nothing _ k = k addCoreScrutTmCs (Just scr) [x] k = - flip locallyExtendPmDeltas k $ \deltas -> - addPmCtsDeltas deltas (unitBag (PmCoreCt x scr)) + flip locallyExtendPmNablas k $ \nablas -> + addPmCtsNablas nablas (unitBag (PmCoreCt x scr)) addCoreScrutTmCs _ _ _ = panic "addCoreScrutTmCs: scrutinee, but more than one match id" -- | 'addCoreScrutTmCs', but desugars the 'LHsExpr' first. @@ -1437,10 +1455,10 @@ of @f at . To achieve similar reasoning in the coverage checker, we keep track of the set of values that can reach a particular program point (often loosely referred to -as "Covered set") in 'GHC.HsToCore.Monad.dsl_deltas'. -We fill that set with Covered Deltas returned by the exported checking +as "Covered set") in 'GHC.HsToCore.Monad.dsl_nablas'. +We fill that set with Covered Nablas returned by the exported checking functions, which the call sites put into place with -'GHC.HsToCore.Monad.updPmDeltas'. +'GHC.HsToCore.Monad.updPmNablas'. Call sites also extend this set with facts from type-constraint dictionaries, case scrutinees, etc. with the exported functions 'addTyCs', 'addCoreScrutTmCs' and 'addHsScrutTmCs'. @@ -1458,7 +1476,7 @@ This is because the constraint (Int ~ Bool) in `f` is unsatisfiable, and the coverage checker deems any matches with unsatisfiable constraint sets to be unreachable. -We make sure to always start from an inhabited 'Deltas' by calling -'getLdiDeltas', which falls back to the trivially inhabited 'Deltas' if the -long-distance info returned by 'GHC.HsToCore.Monad.getPmDeltas' is empty. +We make sure to always start from an inhabited 'Nablas' by calling +'getLdiNablas', which falls back to the trivially inhabited 'Nablas' if the +long-distance info returned by 'GHC.HsToCore.Monad.getPmNablas' is empty. -} ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -4,22 +4,25 @@ Authors: George Karachalias Ryan Scott -} -{-# LANGUAGE CPP, LambdaCase, TupleSections, PatternSynonyms, ViewPatterns, MultiWayIf #-} +{-# LANGUAGE CPP, LambdaCase, TupleSections, PatternSynonyms, ViewPatterns, MultiWayIf, ScopedTypeVariables #-} -- | The pattern match oracle. The main export of the module are the functions -- 'addPmCts' for adding facts to the oracle, and 'provideEvidence' to turn a --- 'Delta' into a concrete evidence for an equation. +-- 'Nabla' into a concrete evidence for an equation. +-- +-- In terms of the [Lower Your Guards paper](https://dl.acm.org/doi/abs/10.1145/3408989) +-- describing the implementation, this module is concerned with Sections 3.4, 3.6 and 3.7. +-- E.g., it represents refinement types diretly as a normalised refinement type 'Nabla'. module GHC.HsToCore.PmCheck.Oracle ( DsM, tracePm, mkPmId, - Delta, initDeltas, lookupRefuts, lookupSolution, + Nabla, initNablas, lookupRefuts, lookupSolution, PmCt(PmTyCt), PmCts, pattern PmVarCt, pattern PmCoreCt, pattern PmConCt, pattern PmNotConCt, pattern PmBotCt, pattern PmNotBotCt, addPmCts, -- Add a constraint to the oracle. - canDiverge, -- Try to add the term equality x ~ ⊥ provideEvidence ) where @@ -154,12 +157,7 @@ mkOneConFull arg_tys con = do -- to the type oracle let ty_cs = substTheta subst (eqSpecPreds eq_spec ++ thetas) -- Figure out the types of strict constructor fields - let arg_is_strict - | RealDataCon dc <- con - , isNewTyCon (dataConTyCon dc) - = [True] -- See Note [Divergence of Newtype matches] - | otherwise - = map isBanged $ conLikeImplBangs con + let arg_is_strict = map isBanged $ conLikeImplBangs con strict_arg_tys = filterByList arg_is_strict field_tys' return (ex_tvs, vars, listToBag ty_cs, strict_arg_tys) @@ -170,8 +168,8 @@ mkOneConFull arg_tys con = do ------------------------------------- -- * Composable satisfiability checks --- | Given a 'Delta', check if it is compatible with new facts encoded in this --- this check. If so, return 'Just' a potentially extended 'Delta'. Return +-- | Given a 'Nabla', check if it is compatible with new facts encoded in this +-- this check. If so, return 'Just' a potentially extended 'Nabla'. Return -- 'Nothing' if unsatisfiable. -- -- There are three essential SatisfiabilityChecks: @@ -180,22 +178,22 @@ mkOneConFull arg_tys con = do -- 3. 'tysAreNonVoid', checks if the given types have an inhabitant -- Functions like 'pmIsSatisfiable', 'nonVoid' and 'testInhabited' plug these -- together as they see fit. -newtype SatisfiabilityCheck = SC (Delta -> DsM (Maybe Delta)) +newtype SatisfiabilityCheck = SC (Nabla -> DsM (Maybe Nabla)) --- | Check the given 'Delta' for satisfiability by the given --- 'SatisfiabilityCheck'. Return 'Just' a new, potentially extended, 'Delta' if +-- | Check the given 'Nabla' for satisfiability by the given +-- 'SatisfiabilityCheck'. Return 'Just' a new, potentially extended, 'Nabla' if -- successful, and 'Nothing' otherwise. -runSatisfiabilityCheck :: Delta -> SatisfiabilityCheck -> DsM (Maybe Delta) -runSatisfiabilityCheck delta (SC chk) = chk delta +runSatisfiabilityCheck :: Nabla -> SatisfiabilityCheck -> DsM (Maybe Nabla) +runSatisfiabilityCheck nabla (SC chk) = chk nabla -- | Allowing easy composition of 'SatisfiabilityCheck's. instance Semigroup SatisfiabilityCheck where -- This is @a >=> b@ from MaybeT DsM SC a <> SC b = SC c where - c delta = a delta >>= \case + c nabla = a nabla >>= \case Nothing -> pure Nothing - Just delta' -> b delta' + Just nabla' -> b nabla' instance Monoid SatisfiabilityCheck where -- We only need this because of mconcat (which we use in place of sconcat, @@ -214,13 +212,13 @@ instance Monoid SatisfiabilityCheck where -- discussed in GADTs Meet Their Match. For an explanation of what role they -- serve, see @Note [Strict argument type constraints]@. pmIsSatisfiable - :: Delta -- ^ The ambient term and type constraints + :: Nabla -- ^ The ambient term and type constraints -- (known to be satisfiable). -> Bag TyCt -- ^ The new type constraints. -> Bag TmCt -- ^ The new term constraints. -> [Type] -- ^ The strict argument types. - -> DsM (Maybe Delta) - -- ^ @'Just' delta@ if the constraints (@delta@) are + -> DsM (Maybe Nabla) + -- ^ @'Just' nabla@ if the constraints (@nabla@) are -- satisfiable, and each strict argument type is inhabitable. -- 'Nothing' otherwise. pmIsSatisfiable amb_cs new_ty_cs new_tm_cs strict_arg_tys = @@ -493,21 +491,21 @@ tyOracle (TySt inert) cts Nothing -> pprPanic "tyOracle" (vcat $ pprErrMsgBagWithLoc errs) } -- | A 'SatisfiabilityCheck' based on new type-level constraints. --- Returns a new 'Delta' if the new constraints are compatible with existing +-- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. Doesn't bother calling out to the type oracle if the bag of new type -- constraints was empty. Will only recheck 'PossibleMatches' in the term oracle -- for emptiness if the first argument is 'True'. tyIsSatisfiable :: Bool -> Bag PredType -> SatisfiabilityCheck -tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \delta -> +tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \nabla -> if isEmptyBag new_ty_cs - then pure (Just delta) - else tyOracle (delta_ty_st delta) new_ty_cs >>= \case + then pure (Just nabla) + else tyOracle (nabla_ty_st nabla) new_ty_cs >>= \case Nothing -> pure Nothing Just ty_st' -> do - let delta' = delta{ delta_ty_st = ty_st' } + let nabla' = nabla{ nabla_ty_st = ty_st' } if recheck_complete_sets - then ensureAllPossibleMatchesInhabited delta' - else pure (Just delta') + then ensureAllInhabited nabla' + else pure (Just nabla') {- ********************************************************************* @@ -619,21 +617,46 @@ warning messages (which can be alleviated by someone with enough dedication). -} -- | A 'SatisfiabilityCheck' based on new term-level constraints. --- Returns a new 'Delta' if the new constraints are compatible with existing +-- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. tmIsSatisfiable :: Bag TmCt -> SatisfiabilityCheck -tmIsSatisfiable new_tm_cs = SC $ \delta -> runMaybeT $ foldlM addTmCt delta new_tm_cs +tmIsSatisfiable new_tm_cs = SC $ \nabla -> runMaybeT $ foldlM addTmCt nabla new_tm_cs ----------------------- -- * Looking up VarInfo emptyVarInfo :: Id -> VarInfo -emptyVarInfo x = VI (idType x) [] emptyPmAltConSet NoPM +-- We could initialise @bot@ to @Just False@ in case of an unlifted type here, +-- but it's cleaner to let the user of the constraint solver take care of this. +-- After all, there are also strict fields, the unliftedness of which isn't +-- evident in the type. So treating unlifted types here would never be +-- sufficient anyway. +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot NoPM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' lookupVarInfo (TmSt env _) x = fromMaybe (emptyVarInfo x) (lookupSDIE env x) +-- | Like @lookupVarInfo ts x@, but @lookupVarInfo ts x = (y, vi)@ also looks +-- through newtype constructors. We have @x ~ N1 (... (Nk y))@ such that the +-- returned @y@ doesn't have a positive newtype constructor constraint +-- associated with it (yet). The 'VarInfo' returned is that of @y@'s +-- representative. +-- +-- Careful, this means that @idType x@ might be different to @idType y@, even +-- modulo type normalisation! +-- +-- See also Note [Coverage checking Newtype matches]. +lookupVarInfoNT :: TmState -> Id -> (Id, VarInfo) +lookupVarInfoNT ts x = case lookupVarInfo ts x of + VI{ vi_pos = as_newtype -> Just y } -> lookupVarInfoNT ts y + res -> (x, res) + where + as_newtype = listToMaybe . mapMaybe go + go (PmAltConLike (RealDataCon dc), _, [y]) + | isNewDataCon dc = Just y + go _ = Nothing + initPossibleMatches :: TyState -> VarInfo -> DsM VarInfo initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do -- New evidence might lead to refined info on ty, in turn leading to discovery @@ -670,13 +693,6 @@ initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do Just cs -> pure vi{ vi_ty = ty', vi_cache = PM (mkUniqDSet <$> cs) } initPossibleMatches _ vi = pure vi --- | @initLookupVarInfo ts x@ looks up the 'VarInfo' for @x@ in @ts@ and tries --- to initialise the 'vi_cache' component if it was 'NoPM' through --- 'initPossibleMatches'. -initLookupVarInfo :: Delta -> Id -> DsM VarInfo -initLookupVarInfo MkDelta{ delta_tm_st = ts, delta_ty_st = ty_st } x - = initPossibleMatches ty_st (lookupVarInfo ts x) - {- Note [COMPLETE sets on data families] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ User-defined COMPLETE sets involving data families are attached to the family @@ -721,22 +737,11 @@ TyCon, so tc_rep = tc_fam afterwards. -} ------------------------------------------------ --- * Exported utility functions querying 'Delta' +-- * Exported utility functions querying 'Nabla' --- | Check whether adding a constraint @x ~ BOT@ to 'Delta' succeeds. -canDiverge :: Delta -> Id -> Bool -canDiverge delta at MkDelta{ delta_tm_st = ts } x - | VI _ pos neg _ <- lookupVarInfo ts x - = isEmptyPmAltConSet neg && all pos_can_diverge pos - where - pos_can_diverge (PmAltConLike (RealDataCon dc), _, [y]) - -- See Note [Divergence of Newtype matches] - | isNewTyCon (dataConTyCon dc) = canDiverge delta y - pos_can_diverge _ = False - -{- Note [Divergence of Newtype matches] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Newtypes behave rather strangely when compared to ordinary DataCons. In a +{- Note [Coverage checking Newtype matches] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Newtypes have quite peculiar match semantics compared to ordinary DataCons. In a pattern-match, they behave like a irrefutable (lazy) match, but for inhabitation testing purposes (e.g. at construction sites), they behave rather like a DataCon with a *strict* field, because they don't contribute their own bottom and are @@ -751,19 +756,21 @@ This distinction becomes apparent in #17248: If we treat Newtypes like we treat regular DataCons, we would mark the third clause as redundant, which clearly is unsound. The solution: -1. When compiling the PmCon guard in 'pmCompileTree', don't add a @DivergeIf@, - because the match will never diverge. -2. Regard @T2 x@ as 'canDiverge' iff @x@ 'canDiverge'. E.g. @T2 x ~ _|_@ <=> - @x ~ _|_ at . This way, the third clause will still be marked as inaccessible - RHS instead of redundant. -3. When testing for inhabitants ('mkOneConFull'), we regard the newtype field as - strict, so that the newtype is inhabited iff its field is inhabited. +1. 'isPmAltConMatchStrict' returns False for newtypes, indicating that a + newtype match is lazy. +2. When we find @x ~ T2 y@, transfer all constraints on @x@ (which involve @⊥@) + to @y@, similar to what 'equate' does, and don't add a @x /~ ⊥@ constraint. + This way, the third clause will still be marked as inaccessible RHS instead + of redundant. This is ensured by calling 'lookupVarInfoNT'. +3. Immediately reject when we find @x /~ T2 at . +Handling of Newtypes is also described in the Appendix of the Lower Your Guards paper, +where you can find the solution in a perhaps more digestible format. -} -lookupRefuts :: Uniquable k => Delta -> k -> [PmAltCon] +lookupRefuts :: Uniquable k => Nabla -> k -> [PmAltCon] -- Unfortunately we need the extra bit of polymorphism and the unfortunate -- duplication of lookupVarInfo here. -lookupRefuts MkDelta{ delta_tm_st = ts@(TmSt (SDIE env) _) } k = +lookupRefuts MkNabla{ nabla_tm_st = ts@(TmSt (SDIE env) _) } k = case lookupUDFM_Directly env (getUnique k) of Nothing -> [] Just (Indirect y) -> pmAltConSetElems (vi_neg (lookupVarInfo ts y)) @@ -773,10 +780,10 @@ isDataConSolution :: (PmAltCon, [TyVar], [Id]) -> Bool isDataConSolution (PmAltConLike (RealDataCon _), _, _) = True isDataConSolution _ = False --- @lookupSolution delta x@ picks a single solution ('vi_pos') of @x@ from +-- @lookupSolution nabla x@ picks a single solution ('vi_pos') of @x@ from -- possibly many, preferring 'RealDataCon' solutions whenever possible. -lookupSolution :: Delta -> Id -> Maybe (PmAltCon, [TyVar], [Id]) -lookupSolution delta x = case vi_pos (lookupVarInfo (delta_tm_st delta) x) of +lookupSolution :: Nabla -> Id -> Maybe (PmAltCon, [TyVar], [Id]) +lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of [] -> Nothing pos | Just sol <- find isDataConSolution pos -> Just sol @@ -843,13 +850,13 @@ instance Outputable PmCt where ppr (PmTyCt pred_ty) = ppr pred_ty ppr (PmTmCt tm_ct) = ppr tm_ct --- | Adds new constraints to 'Delta' and returns 'Nothing' if that leads to a +-- | Adds new constraints to 'Nabla' and returns 'Nothing' if that leads to a -- contradiction. -addPmCts :: Delta -> PmCts -> DsM (Maybe Delta) +addPmCts :: Nabla -> PmCts -> DsM (Maybe Nabla) -- See Note [TmState invariants]. -addPmCts delta cts = do +addPmCts nabla cts = do let (ty_cts, tm_cts) = partitionTyTmCts cts - runSatisfiabilityCheck delta $ mconcat + runSatisfiabilityCheck nabla $ mconcat [ tyIsSatisfiable True (listToBag ty_cts) , tmIsSatisfiable (listToBag tm_cts) ] @@ -862,44 +869,40 @@ partitionTyTmCts = partitionEithers . map to_either . toList -- | Adds a single term constraint by dispatching to the various term oracle -- functions. -addTmCt :: Delta -> TmCt -> MaybeT DsM Delta -addTmCt delta (TmVarCt x y) = addVarCt delta x y -addTmCt delta (TmCoreCt x e) = addCoreCt delta x e -addTmCt delta (TmConCt x con tvs args) = addConCt delta x con tvs args -addTmCt delta (TmNotConCt x con) = addNotConCt delta x con -addTmCt delta (TmBotCt x) = addBotCt delta x -addTmCt delta (TmNotBotCt x) = addNotBotCt delta x +addTmCt :: Nabla -> TmCt -> MaybeT DsM Nabla +addTmCt nabla (TmVarCt x y) = addVarCt nabla x y +addTmCt nabla (TmCoreCt x e) = addCoreCt nabla x e +addTmCt nabla (TmConCt x con tvs args) = addConCt nabla x con tvs args +addTmCt nabla (TmNotConCt x con) = addNotConCt nabla x con +addTmCt nabla (TmBotCt x) = addBotCt nabla x +addTmCt nabla (TmNotBotCt x) = addNotBotCt nabla x -- | Adds the constraint @x ~ ⊥@, e.g. that evaluation of a particular 'Id' @x@ --- surely diverges. --- --- Only that's a lie, because we don't currently preserve the fact in 'Delta' --- after we checked compatibility. See Note [Preserving TmBotCt] -addBotCt :: Delta -> Id -> MaybeT DsM Delta -addBotCt delta x - | canDiverge delta x = pure delta - | otherwise = mzero - -{- Note [Preserving TmBotCt] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Whenever we add a new constraint to 'Delta' via 'addTmCt', we want to check it -for compatibility with existing constraints in the modeled indert set and then -add it the constraint itself to the inert set. -For a 'TmBotCt' @x ~ ⊥@ we don't actually add it to the inert set after checking -it for compatibility with 'Delta'. -And that is fine in the context of the patter-match checking algorithm! -Whenever we add a 'TmBotCt' (we only do so for checking divergence of bang -patterns and strict constructor matches), we don't add any more constraints to -the inert set afterwards, so we don't need to preserve it. --} +-- surely diverges. Quite similar to 'addConCt', only that it only cares about +-- ⊥. +addBotCt :: Nabla -> Id -> MaybeT DsM Nabla +addBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do + let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + case bot of + IsNotBot -> mzero -- There was x /~ ⊥. Contradiction! + IsBot -> pure nabla -- There already is x ~ ⊥. Nothing left to do + MaybeBot -> do -- We add x ~ ⊥ + let vi' = vi{ vi_bot = IsBot } + pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env y vi') reps} -- | Record a @x ~/ K@ constraint, e.g. that a particular 'Id' @x@ can't --- take the shape of a 'PmAltCon' @K@ in the 'Delta' and return @Nothing@ if +-- take the shape of a 'PmAltCon' @K@ in the 'Nabla' and return @Nothing@ if -- that leads to a contradiction. -- See Note [TmState invariants]. -addNotConCt :: Delta -> Id -> PmAltCon -> MaybeT DsM Delta -addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do - vi@(VI _ pos neg pm) <- lift (initLookupVarInfo delta x) +addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla +addNotConCt _ _ (PmAltConLike (RealDataCon dc)) + | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] +addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do + -- For good performance, it's important to initPossibleMatches here. + -- Otherwise we can't mark nalt as matched later on, incurring unnecessary + -- inhabitation tests for nalt. + vi@(VI _ pos neg _ pm) <- lift $ initPossibleMatches (nabla_ty_st nabla) + (lookupVarInfo ts x) -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt (cl, _tvs, _args) = eqPmAltCon cl nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -911,13 +914,14 @@ addNotConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x nalt = do -- See Note [Completeness checking with required Thetas] | hasRequiredTheta nalt = neg | otherwise = extendPmAltConSet neg nalt - let vi_ext = vi{ vi_neg = neg' } + MASSERT( isPmAltConMatchStrict nalt ) + let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor - vi' <- case nalt of + vi2 <- case nalt of PmAltConLike cl - -> MaybeT (ensureInhabited delta vi_ext{ vi_cache = markMatched cl pm }) - _ -> pure vi_ext - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x vi') reps } + -> ensureInhabited nabla vi1{ vi_cache = markMatched cl pm } + _ -> pure vi1 + pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } hasRequiredTheta :: PmAltCon -> Bool hasRequiredTheta (PmAltConLike cl) = notNull req_theta @@ -980,100 +984,104 @@ guessConLikeUnivTyArgsFromResTy _ res_ty (PatSynCon ps) = do subst <- tcMatchTy con_res_ty res_ty traverse (lookupTyVar subst) univ_tvs --- | Adds the constraint @x ~/ ⊥@ to 'Delta'. +-- | Adds the constraint @x ~/ ⊥@ to 'Nabla'. Quite similar to 'addNotConCt', +-- but only cares for the ⊥ "constructor". +addNotBotCt :: Nabla -> Id -> MaybeT DsM Nabla +addNotBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do + let (y, vi at VI { vi_bot = bot }) = lookupVarInfoNT (nabla_tm_st nabla) x + case bot of + IsBot -> mzero -- There was x ~ ⊥. Contradiction! + IsNotBot -> pure nabla -- There already is x /~ ⊥. Nothing left to do + MaybeBot -> do -- We add x /~ ⊥ and test if x is still inhabited + vi <- ensureInhabited nabla vi{ vi_bot = IsNotBot } + pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env y vi) reps} + +-- | Returns (Just vi) if at least one member of each ConLike in the COMPLETE +-- set satisfies the oracle -- --- But doesn't really commit to upholding that constraint in the future. This --- will be rectified in a follow-up patch. The status quo should work good --- enough for now. -addNotBotCt :: Delta -> Id -> MaybeT DsM Delta -addNotBotCt delta at MkDelta{ delta_tm_st = TmSt env reps } x = do - vi <- lift $ initLookupVarInfo delta x - vi' <- MaybeT $ ensureInhabited delta vi - -- vi' has probably constructed and then thinned out some PossibleMatches. - -- We want to cache that work - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x vi') reps} - -ensureInhabited :: Delta -> VarInfo -> DsM (Maybe VarInfo) - -- Returns (Just vi) if at least one member of each ConLike in the COMPLETE - -- set satisfies the oracle - -- - -- Internally uses and updates the ConLikeSets in vi_cache. - -- - -- NB: Does /not/ filter each ConLikeSet with the oracle; members may - -- remain that do not statisfy it. This lazy approach just - -- avoids doing unnecessary work. -ensureInhabited delta vi = fmap (set_cache vi) <$> test (vi_cache vi) -- This would be much less tedious with lenses +-- Internally uses and updates the ConLikeSets in vi_cache. +-- +-- NB: Does /not/ filter each ConLikeSet with the oracle; members may +-- remain that do not statisfy it. This lazy approach just +-- avoids doing unnecessary work. +ensureInhabited :: Nabla -> VarInfo -> MaybeT DsM VarInfo +ensureInhabited nabla vi = case vi_bot vi of + MaybeBot -> pure vi -- The |-Bot rule from the paper + IsBot -> pure vi + IsNotBot -> lift (initPossibleMatches (nabla_ty_st nabla) vi) >>= inst_complete_sets where - set_cache vi cache = vi { vi_cache = cache } - - test NoPM = pure (Just NoPM) - test (PM ms) = runMaybeT (PM <$> traverse one_set ms) - - one_set cs = find_one_inh cs (uniqDSetToList cs) - - find_one_inh :: ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet - -- (find_one_inh cs cls) iterates over cls, deleting from cs + -- | This is the |-Inst rule from the paper (section 4.5). Tries to + -- find an inhabitant in every complete set by instantiating with one their + -- constructors. If there is any complete set where we can't find an + -- inhabitant, the whole thing is uninhabited. + inst_complete_sets :: VarInfo -> MaybeT DsM VarInfo + inst_complete_sets vi at VI{ vi_cache = NoPM } = pure vi + inst_complete_sets vi at VI{ vi_cache = PM ms } = do + ms <- traverse (\cs -> inst_complete_set vi cs (uniqDSetToList cs)) ms + pure vi{ vi_cache = PM ms } + + inst_complete_set :: VarInfo -> ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet + -- (inst_complete_set cs cls) iterates over cls, deleting from cs -- any uninhabited elements of cls. Stop (returning Just cs) -- when you see an inhabited element; return Nothing if all -- are uninhabited - find_one_inh _ [] = mzero - find_one_inh cs (con:cons) = lift (inh_test con) >>= \case + inst_complete_set _ _ [] = mzero + inst_complete_set vi cs (con:cons) = lift (inst_and_test vi con) >>= \case True -> pure cs - False -> find_one_inh (delOneFromUniqDSet cs con) cons + False -> inst_complete_set vi (delOneFromUniqDSet cs con) cons - inh_test :: ConLike -> DsM Bool - -- @inh_test K@ Returns False if a non-bottom value @v::ty@ cannot possibly + inst_and_test :: VarInfo -> ConLike -> DsM Bool + -- @inst_and_test K@ Returns False if a non-bottom value @v::ty@ cannot possibly -- be of form @K _ _ _ at . Returning True is always sound. -- -- It's like 'DataCon.dataConCannotMatch', but more clever because it takes - -- the facts in Delta into account. - inh_test con = do + -- the facts in Nabla into account. + inst_and_test vi con = do env <- dsGetFamInstEnvs case guessConLikeUnivTyArgsFromResTy env (vi_ty vi) con of Nothing -> pure True -- be conservative about this Just arg_tys -> do (_tvs, _vars, ty_cs, strict_arg_tys) <- mkOneConFull arg_tys con - tracePm "inh_test" (ppr con $$ ppr ty_cs) + tracePm "inst_and_test" (ppr con $$ ppr ty_cs) -- No need to run the term oracle compared to pmIsSatisfiable - fmap isJust <$> runSatisfiabilityCheck delta $ mconcat + fmap isJust <$> runSatisfiabilityCheck nabla $ mconcat -- Important to pass False to tyIsSatisfiable here, so that we won't - -- recursively call ensureAllPossibleMatchesInhabited, leading to an + -- recursively call ensureAllInhabited, leading to an -- endless recursion. [ tyIsSatisfiable False ty_cs , tysAreNonVoid initRecTc strict_arg_tys ] -- | Checks if every 'VarInfo' in the term oracle has still an inhabited --- 'vi_cache', considering the current type information in 'Delta'. +-- 'vi_cache', considering the current type information in 'Nabla'. -- This check is necessary after having matched on a GADT con to weed out -- impossible matches. -ensureAllPossibleMatchesInhabited :: Delta -> DsM (Maybe Delta) -ensureAllPossibleMatchesInhabited delta at MkDelta{ delta_tm_st = TmSt env reps } - = runMaybeT (set_tm_cs_env delta <$> traverseSDIE go env) +ensureAllInhabited :: Nabla -> DsM (Maybe Nabla) +ensureAllInhabited nabla at MkNabla{ nabla_tm_st = TmSt env reps } + = runMaybeT (set_tm_cs_env nabla <$> traverseSDIE go env) where - set_tm_cs_env delta env = delta{ delta_tm_st = TmSt env reps } - go vi = MaybeT $ - initPossibleMatches (delta_ty_st delta) vi >>= ensureInhabited delta + set_tm_cs_env nabla env = nabla{ nabla_tm_st = TmSt env reps } + go vi = ensureInhabited nabla vi -------------------------------------- -- * Term oracle unification procedure -- | Adds a @x ~ y@ constraint by trying to unify two 'Id's and record the --- gained knowledge in 'Delta'. +-- gained knowledge in 'Nabla'. -- --- Returns @Nothing@ when there's a contradiction. Returns @Just delta@ --- when the constraint was compatible with prior facts, in which case @delta@ +-- Returns @Nothing@ when there's a contradiction. Returns @Just nabla@ +-- when the constraint was compatible with prior facts, in which case @nabla@ -- has integrated the knowledge from the equality constraint. -- -- See Note [TmState invariants]. -addVarCt :: Delta -> Id -> Id -> MaybeT DsM Delta -addVarCt delta at MkDelta{ delta_tm_st = TmSt env _ } x y +addVarCt :: Nabla -> Id -> Id -> MaybeT DsM Nabla +addVarCt nabla at MkNabla{ nabla_tm_st = TmSt env _ } x y -- It's important that we never @equate@ two variables of the same equivalence -- class, otherwise we might get cyclic substitutions. -- Cf. 'extendSubstAndSolve' and -- @testsuite/tests/pmcheck/should_compile/CyclicSubst.hs at . - | sameRepresentativeSDIE env x y = pure delta - | otherwise = equate delta x y + | sameRepresentativeSDIE env x y = pure nabla + | otherwise = equate nabla x y -- | @equate ts@(TmSt env) x y@ merges the equivalence classes of @x@ and @y@ by -- adding an indirection to the environment. @@ -1082,12 +1090,12 @@ addVarCt delta at MkDelta{ delta_tm_st = TmSt env _ } x y -- Preconditions: @not (sameRepresentativeSDIE env x y)@ -- -- See Note [TmState invariants]. -equate :: Delta -> Id -> Id -> MaybeT DsM Delta -equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y +equate :: Nabla -> Id -> Id -> MaybeT DsM Nabla +equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y = ASSERT( not (sameRepresentativeSDIE env x y) ) case (lookupSDIE env x, lookupSDIE env y) of - (Nothing, _) -> pure (delta{ delta_tm_st = TmSt (setIndirectSDIE env x y) reps }) - (_, Nothing) -> pure (delta{ delta_tm_st = TmSt (setIndirectSDIE env y x) reps }) + (Nothing, _) -> pure (nabla{ nabla_tm_st = TmSt (setIndirectSDIE env x y) reps }) + (_, Nothing) -> pure (nabla{ nabla_tm_st = TmSt (setIndirectSDIE env y x) reps }) -- Merge the info we have for x into the info for y (Just vi_x, Just vi_y) -> do -- This assert will probably trigger at some point... @@ -1097,16 +1105,16 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y let env_ind = setIndirectSDIE env x y -- Then sum up the refinement counters let env_refs = setEntrySDIE env_ind y vi_y - let delta_refs = delta{ delta_tm_st = TmSt env_refs reps } + let nabla_refs = nabla{ nabla_tm_st = TmSt env_refs reps } -- and then gradually merge every positive fact we have on x into y - let add_fact delta (cl, tvs, args) = addConCt delta y cl tvs args - delta_pos <- foldlM add_fact delta_refs (vi_pos vi_x) + let add_fact nabla (cl, tvs, args) = addConCt nabla y cl tvs args + nabla_pos <- foldlM add_fact nabla_refs (vi_pos vi_x) -- Do the same for negative info - let add_refut delta nalt = addNotConCt delta y nalt - delta_neg <- foldlM add_refut delta_pos (pmAltConSetElems (vi_neg vi_x)) + let add_refut nabla nalt = addNotConCt nabla y nalt + nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) -- vi_cache will be updated in addNotConCt, so we are good to -- go! - pure delta_neg + pure nabla_neg -- | Add a @x ~ K tvs args ts@ constraint. -- @addConCt x K tvs args ts@ extends the substitution with a solution @@ -1114,9 +1122,9 @@ equate delta at MkDelta{ delta_tm_st = TmSt env reps } x y -- have on @x@, reject (@Nothing@) otherwise. -- -- See Note [TmState invariants]. -addConCt :: Delta -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Delta -addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do - VI ty pos neg cache <- lift (initLookupVarInfo delta x) +addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla +addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do + let VI ty pos neg bot cache = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -1132,10 +1140,19 @@ addConCt delta at MkDelta{ delta_tm_st = TmSt env reps } x alt tvs args = do when (length args /= length other_args) $ lift $ tracePm "error" (ppr x <+> ppr alt <+> ppr args <+> ppr other_args) let tm_cts = zipWithEqual "addConCt" PmVarCt args other_args - MaybeT $ addPmCts delta (listToBag ty_cts `unionBags` listToBag tm_cts) + MaybeT $ addPmCts nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = (alt, tvs, args):pos - pure delta{ delta_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg cache)) reps} + let nabla_with bot = nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot cache)) reps} + -- Do (2) in Note [Coverage checking Newtype matches] + case (alt, args) of + (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> + case bot of + MaybeBot -> pure (nabla_with MaybeBot) + IsBot -> addBotCt (nabla_with MaybeBot) y + IsNotBot -> addNotBotCt (nabla_with MaybeBot) y + _ -> ASSERT( isPmAltConMatchStrict alt ) + pure (nabla_with IsNotBot) -- strict match ==> not ⊥ equateTys :: [Type] -> [Type] -> [PmCt] equateTys ts us = @@ -1184,9 +1201,9 @@ mkInhabitationCandidate x dc = do -- if it can. In this case, the candidates are the signature of the tycon, each -- one accompanied by the term- and type- constraints it gives rise to. -- See also Note [Checking EmptyCase Expressions] -inhabitationCandidates :: Delta -> Type +inhabitationCandidates :: Nabla -> Type -> DsM (Either Type (TyCon, Id, [InhabitationCandidate])) -inhabitationCandidates MkDelta{ delta_ty_st = ty_st } ty = do +inhabitationCandidates MkNabla{ nabla_ty_st = ty_st } ty = do pmTopNormaliseType ty_st ty >>= \case NoChange _ -> alts_to_check ty ty [] NormalisedByConstraints ty' -> alts_to_check ty' ty' [] @@ -1282,20 +1299,20 @@ we do the following: -- | A 'SatisfiabilityCheck' based on "NonVoid ty" constraints, e.g. Will -- check if the @strict_arg_tys@ are actually all inhabited. --- Returns the old 'Delta' if all the types are non-void according to 'Delta'. +-- Returns the old 'Nabla' if all the types are non-void according to 'Nabla'. tysAreNonVoid :: RecTcChecker -> [Type] -> SatisfiabilityCheck -tysAreNonVoid rec_env strict_arg_tys = SC $ \delta -> do - all_non_void <- checkAllNonVoid rec_env delta strict_arg_tys +tysAreNonVoid rec_env strict_arg_tys = SC $ \nabla -> do + all_non_void <- checkAllNonVoid rec_env nabla strict_arg_tys -- Check if each strict argument type is inhabitable pure $ if all_non_void - then Just delta + then Just nabla else Nothing -- | Implements two performance optimizations, as described in -- @Note [Strict argument type constraints]@. -checkAllNonVoid :: RecTcChecker -> Delta -> [Type] -> DsM Bool +checkAllNonVoid :: RecTcChecker -> Nabla -> [Type] -> DsM Bool checkAllNonVoid rec_ts amb_cs strict_arg_tys = do - let definitely_inhabited = definitelyInhabitedType (delta_ty_st amb_cs) + let definitely_inhabited = definitelyInhabitedType (nabla_ty_st amb_cs) tys_to_check <- filterOutM definitely_inhabited strict_arg_tys -- See Note [Fuel for the inhabitation test] let rec_max_bound | tys_to_check `lengthExceeds` 1 @@ -1310,7 +1327,7 @@ checkAllNonVoid rec_ts amb_cs strict_arg_tys = do -- See @Note [Strict argument type constraints]@. nonVoid :: RecTcChecker -- ^ The per-'TyCon' recursion depth limit. - -> Delta -- ^ The ambient term/type constraints (known to be + -> Nabla -- ^ The ambient term/type constraints (known to be -- satisfiable). -> Type -- ^ The strict argument type. -> DsM Bool -- ^ 'True' if the strict argument type might be inhabited by @@ -1338,7 +1355,7 @@ nonVoid rec_ts amb_cs strict_arg_ty = do -- check if recursion is detected). -- -- See Note [Strict argument type constraints] - cand_is_inhabitable :: RecTcChecker -> Delta + cand_is_inhabitable :: RecTcChecker -> Nabla -> InhabitationCandidate -> DsM Bool cand_is_inhabitable rec_ts amb_cs (InhabitationCandidate{ ic_cs = new_cs @@ -1517,21 +1534,21 @@ on a list of strict argument types, we filter out all of the DI ones. -} -------------------------------------------- --- * Providing positive evidence for a Delta +-- * Providing positive evidence for a Nabla --- | @provideEvidence vs n delta@ returns a list of --- at most @n@ (but perhaps empty) refinements of @delta@ that instantiate +-- | @provideEvidence vs n nabla@ returns a list of +-- at most @n@ (but perhaps empty) refinements of @nabla@ that instantiate -- @vs@ to compatible constructor applications or wildcards. -- Negative information is only retained if literals are involved or when -- for recursive GADTs. -provideEvidence :: [Id] -> Int -> Delta -> DsM [Delta] +provideEvidence :: [Id] -> Int -> Nabla -> DsM [Nabla] provideEvidence = go where go _ 0 _ = pure [] - go [] _ delta = pure [delta] - go (x:xs) n delta = do - tracePm "provideEvidence" (ppr x $$ ppr xs $$ ppr delta $$ ppr n) - VI _ pos neg _ <- initLookupVarInfo delta x + go [] _ nabla = pure [nabla] + go (x:xs) n nabla = do + tracePm "provideEvidence" (ppr x $$ ppr xs $$ ppr nabla $$ ppr n) + let VI _ pos neg _ _ = lookupVarInfo (nabla_tm_st nabla) x case pos of _:_ -> do -- All solutions must be valid at once. Try to find candidates for their @@ -1544,56 +1561,58 @@ provideEvidence = go -- some @y@ and @SomePatSyn z@ for some @z at . We must find evidence for @y@ -- and @z@ that is valid at the same time. These constitute arg_vas below. let arg_vas = concatMap (\(_cl, _tvs, args) -> args) pos - go (arg_vas ++ xs) n delta + go (arg_vas ++ xs) n nabla [] -- When there are literals involved, just print negative info -- instead of listing missed constructors | notNull [ l | PmAltLit l <- pmAltConSetElems neg ] - -> go xs n delta - [] -> try_instantiate x xs n delta + -> go xs n nabla + [] -> try_instantiate x xs n nabla -- | Tries to instantiate a variable by possibly following the chain of -- newtypes and then instantiating to all ConLikes of the wrapped type's -- minimal residual COMPLETE set. - try_instantiate :: Id -> [Id] -> Int -> Delta -> DsM [Delta] + try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. - try_instantiate x xs n delta = do - (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (delta_ty_st delta) (idType x) - let build_newtype (x, delta) (_ty, dc, arg_ty) = do + try_instantiate x xs n nabla = do + (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + let build_newtype (x, nabla) (_ty, dc, arg_ty) = do y <- lift $ mkPmId arg_ty -- Newtypes don't have existentials (yet?!), so passing an empty -- list as ex_tvs. - delta' <- addConCt delta x (PmAltConLike (RealDataCon dc)) [] [y] - pure (y, delta') - runMaybeT (foldlM build_newtype (x, delta) dcs) >>= \case + nabla' <- addConCt nabla x (PmAltConLike (RealDataCon dc)) [] [y] + pure (y, nabla') + runMaybeT (foldlM build_newtype (x, nabla) dcs) >>= \case Nothing -> pure [] - Just (y, newty_delta) -> do + Just (y, newty_nabla) -> do -- Pick a COMPLETE set and instantiate it (n at max). Take care of ⊥. - pm <- vi_cache <$> initLookupVarInfo newty_delta y - mb_cls <- pickMinimalCompleteSet newty_delta pm + let vi = lookupVarInfo (nabla_tm_st newty_nabla) y + vi <- initPossibleMatches (nabla_ty_st newty_nabla) vi + mb_cls <- pickMinimalCompleteSet newty_nabla (vi_cache vi) case uniqDSetToList <$> mb_cls of - Just cls@(_:_) -> instantiate_cons y core_ty xs n newty_delta cls - Just [] | not (canDiverge newty_delta y) -> pure [] - -- Either ⊥ is still possible (think Void) or there are no COMPLETE - -- sets available, so we can assume it's inhabited - _ -> go xs n newty_delta - - instantiate_cons :: Id -> Type -> [Id] -> Int -> Delta -> [ConLike] -> DsM [Delta] + Just cls -> do + nablas <- instantiate_cons y core_ty xs n newty_nabla cls + if null nablas && vi_bot vi /= IsNotBot + then go xs n newty_nabla -- bot is still possible. Display a wildcard! + else pure nablas + Nothing -> go xs n newty_nabla -- no COMPLETE sets ==> inhabited + + instantiate_cons :: Id -> Type -> [Id] -> Int -> Nabla -> [ConLike] -> DsM [Nabla] instantiate_cons _ _ _ _ _ [] = pure [] instantiate_cons _ _ _ 0 _ _ = pure [] - instantiate_cons _ ty xs n delta _ + instantiate_cons _ ty xs n nabla _ -- We don't want to expose users to GHC-specific constructors for Int etc. | fmap (isTyConTriviallyInhabited . fst) (splitTyConApp_maybe ty) == Just True - = go xs n delta - instantiate_cons x ty xs n delta (cl:cls) = do + = go xs n nabla + instantiate_cons x ty xs n nabla (cl:cls) = do env <- dsGetFamInstEnvs case guessConLikeUnivTyArgsFromResTy env ty cl of - Nothing -> pure [delta] -- No idea how to refine this one, so just finish off with a wildcard + Nothing -> pure [nabla] -- No idea how to refine this one, so just finish off with a wildcard Just arg_tys -> do (tvs, arg_vars, new_ty_cs, strict_arg_tys) <- mkOneConFull arg_tys cl let new_tm_cs = unitBag (TmConCt x (PmAltConLike cl) tvs arg_vars) -- Now check satifiability - mb_delta <- pmIsSatisfiable delta new_ty_cs new_tm_cs strict_arg_tys + mb_nabla <- pmIsSatisfiable nabla new_ty_cs new_tm_cs strict_arg_tys tracePm "instantiate_cons" (vcat [ ppr x , ppr (idType x) , ppr ty @@ -1602,21 +1621,21 @@ provideEvidence = go , ppr new_tm_cs , ppr new_ty_cs , ppr strict_arg_tys - , ppr delta - , ppr mb_delta + , ppr nabla + , ppr mb_nabla , ppr n ]) - con_deltas <- case mb_delta of + con_nablas <- case mb_nabla of Nothing -> pure [] -- NB: We don't prepend arg_vars as we don't have any evidence on -- them and we only want to split once on a data type. They are -- inhabited, otherwise pmIsSatisfiable would have refuted. - Just delta' -> go xs n delta' - other_cons_deltas <- instantiate_cons x ty xs (n - length con_deltas) delta cls - pure (con_deltas ++ other_cons_deltas) + Just nabla' -> go xs n nabla' + other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls + pure (con_nablas ++ other_cons_nablas) -pickMinimalCompleteSet :: Delta -> PossibleMatches -> DsM (Maybe ConLikeSet) +pickMinimalCompleteSet :: Nabla -> PossibleMatches -> DsM (Maybe ConLikeSet) pickMinimalCompleteSet _ NoPM = pure Nothing --- TODO: First prune sets with type info in delta. But this is good enough for +-- TODO: First prune sets with type info in nabla. But this is good enough for -- now and less costly. See #17386. pickMinimalCompleteSet _ (PM clss) = do tracePm "pickMinimalCompleteSet" (ppr $ NonEmpty.toList clss) @@ -1626,14 +1645,14 @@ pickMinimalCompleteSet _ (PM clss) = do -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically -- equivalent to @e'@) we encountered earlier, or a fresh identifier if -- there weren't any such constraints. -representCoreExpr :: Delta -> CoreExpr -> DsM (Delta, Id) -representCoreExpr delta at MkDelta{ delta_tm_st = ts at TmSt{ ts_reps = reps } } e - | Just rep <- lookupCoreMap reps e = pure (delta, rep) +representCoreExpr :: Nabla -> CoreExpr -> DsM (Nabla, Id) +representCoreExpr nabla at MkNabla{ nabla_tm_st = ts at TmSt{ ts_reps = reps } } e + | Just rep <- lookupCoreMap reps e = pure (nabla, rep) | otherwise = do rep <- mkPmId (exprType e) let reps' = extendCoreMap reps e rep - let delta' = delta{ delta_tm_st = ts{ ts_reps = reps' } } - pure (delta', rep) + let nabla' = nabla{ nabla_tm_st = ts{ ts_reps = reps' } } + pure (nabla', rep) -- | Inspects a 'PmCoreCt' @let x = e@ by recording constraints for @x@ based -- on the shape of the 'CoreExpr' @e at . Examples: @@ -1647,16 +1666,16 @@ representCoreExpr delta at MkDelta{ delta_tm_st = ts at TmSt{ ts_reps = reps } } e -- for other literals. See 'coreExprAsPmLit'. -- * Finally, if we have @let x = e@ and we already have seen @let y = e@, we -- want to record @x ~ y at . -addCoreCt :: Delta -> Id -> CoreExpr -> MaybeT DsM Delta -addCoreCt delta x e = do +addCoreCt :: Nabla -> Id -> CoreExpr -> MaybeT DsM Nabla +addCoreCt nabla x e = do simpl_opts <- initSimpleOpts <$> getDynFlags let e' = simpleOptExpr simpl_opts e - lift $ tracePm "addCoreCt" (ppr x <+> dcolon <+> ppr (idType x) $$ ppr e $$ ppr e') - execStateT (core_expr x e') delta + -- lift $ tracePm "addCoreCt" (ppr x <+> dcolon <+> ppr (idType x) $$ ppr e $$ ppr e') + execStateT (core_expr x e') nabla where -- | Takes apart a 'CoreExpr' and tries to extract as much information about -- literals and constructor applications as possible. - core_expr :: Id -> CoreExpr -> StateT Delta (MaybeT DsM) () + core_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () -- TODO: Handle newtypes properly, by wrapping the expression in a DataCon -- This is the right thing for casts involving data family instances and -- their representation TyCon, though (which are not visible in source @@ -1681,7 +1700,7 @@ addCoreCt delta x e = do -- See Note [Detecting pattern synonym applications in expressions] | Var y <- e, Nothing <- isDataConId_maybe x -- We don't consider DataCons flexible variables - = modifyT (\delta -> addVarCt delta x y) + = modifyT (\nabla -> addVarCt nabla x y) | otherwise -- Any other expression. Try to find other uses of a semantically -- equivalent expression and represent them by the same variable! @@ -1699,13 +1718,13 @@ addCoreCt delta x e = do -- see if we already encountered a constraint @let y = e'@ with @e'@ -- semantically equivalent to @e@, in which case we may add the constraint -- @x ~ y at . - equate_with_similar_expr :: Id -> CoreExpr -> StateT Delta (MaybeT DsM) () + equate_with_similar_expr :: Id -> CoreExpr -> StateT Nabla (MaybeT DsM) () equate_with_similar_expr x e = do - rep <- StateT $ \delta -> swap <$> lift (representCoreExpr delta e) + rep <- StateT $ \nabla -> swap <$> lift (representCoreExpr nabla e) -- Note that @rep == x@ if we encountered @e@ for the first time. - modifyT (\delta -> addVarCt delta x rep) + modifyT (\nabla -> addVarCt nabla x rep) - bind_expr :: CoreExpr -> StateT Delta (MaybeT DsM) Id + bind_expr :: CoreExpr -> StateT Nabla (MaybeT DsM) Id bind_expr e = do x <- lift (lift (mkPmId (exprType e))) core_expr x e @@ -1713,10 +1732,12 @@ addCoreCt delta x e = do -- | Look at @let x = K taus theta es@ and generate the following -- constraints (assuming universals were dropped from @taus@ before): - -- 1. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i@ - -- 2. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ - -- 3. @x ~ K as ys@ - data_con_app :: Id -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Delta (MaybeT DsM) () + -- 1. @x /~ ⊥@ if 'K' is not a Newtype constructor. + -- 2. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i@ + -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ + -- 4. @x ~ K as ys@ + -- This is quite similar to PmCheck.pmConCts. + data_con_app :: Id -> InScopeSet -> DataCon -> [CoreExpr] -> StateT Nabla (MaybeT DsM) () data_con_app x in_scope dc args = do let dc_ex_tvs = dataConExTyCoVars dc arty = dataConSourceArity dc @@ -1726,20 +1747,27 @@ addCoreCt delta x e = do uniq_supply <- lift $ lift $ getUniqueSupplyM let (_, ex_tvs) = cloneTyVarBndrs (mkEmptyTCvSubst in_scope) dc_ex_tvs uniq_supply ty_cts = equateTys (map mkTyVarTy ex_tvs) ex_tys - -- 1. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i at . See also #17703 - modifyT $ \delta -> MaybeT $ addPmCts delta (listToBag ty_cts) - -- 2. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ + -- 1. @x /~ ⊥@ if 'K' is not a Newtype constructor (#18341) + when (not (isNewDataCon dc)) $ + modifyT $ \nabla -> addNotBotCt nabla x + -- 2. @a_1 ~ tau_1, ..., a_n ~ tau_n@ for fresh @a_i at . See also #17703 + modifyT $ \nabla -> MaybeT $ addPmCts nabla (listToBag ty_cts) + -- 3. @y_1 ~ e_1, ..., y_m ~ e_m@ for fresh @y_i@ arg_ids <- traverse bind_expr vis_args - -- 3. @x ~ K as ys@ + -- 4. @x ~ K as ys@ pm_alt_con_app x (PmAltConLike (RealDataCon dc)) ex_tvs arg_ids -- | Adds a literal constraint, i.e. @x ~ 42 at . - pm_lit :: Id -> PmLit -> StateT Delta (MaybeT DsM) () - pm_lit x lit = pm_alt_con_app x (PmAltLit lit) [] [] + -- Also we assume that literal expressions won't diverge, so this + -- will add a @x ~/ ⊥@ constraint. + pm_lit :: Id -> PmLit -> StateT Nabla (MaybeT DsM) () + pm_lit x lit = do + modifyT $ \nabla -> addNotBotCt nabla x + pm_alt_con_app x (PmAltLit lit) [] [] -- | Adds the given constructor application as a solution for @x at . - pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Delta (MaybeT DsM) () - pm_alt_con_app x con tvs args = modifyT $ \delta -> addConCt delta x con tvs args + pm_alt_con_app :: Id -> PmAltCon -> [TyVar] -> [Id] -> StateT Nabla (MaybeT DsM) () + pm_alt_con_app x con tvs args = modifyT $ \nabla -> addConCt nabla x con tvs args -- | Like 'modify', but with an effectful modifier action modifyT :: Monad m => (s -> m s) -> StateT s m () ===================================== compiler/GHC/HsToCore/PmCheck/Ppr.hs ===================================== @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} --- | Provides factilities for pretty-printing 'Delta's in a way appropriate for +-- | Provides factilities for pretty-printing 'Nabla's in a way appropriate for -- user facing pattern match warnings. module GHC.HsToCore.PmCheck.Ppr ( pprUncovered @@ -42,8 +42,8 @@ import GHC.HsToCore.PmCheck.Oracle -- -- When the set of refutable shapes contains more than 3 elements, the -- additional elements are indicated by "...". -pprUncovered :: Delta -> [Id] -> SDoc -pprUncovered delta vas +pprUncovered :: Nabla -> [Id] -> SDoc +pprUncovered nabla vas | isNullUDFM refuts = fsep vec -- there are no refutations | otherwise = hang (fsep vec) 4 $ text "where" <+> vcat (map (pprRefutableShapes . snd) (udfmToList refuts)) @@ -54,8 +54,8 @@ pprUncovered delta vas | [_] <- vas = topPrec | otherwise = appPrec ppr_action = mapM (pprPmVar init_prec) vas - (vec, renamings) = runPmPpr delta ppr_action - refuts = prettifyRefuts delta renamings + (vec, renamings) = runPmPpr nabla ppr_action + refuts = prettifyRefuts nabla renamings -- | Output refutable shapes of a variable in the form of @var is not one of {2, -- Nothing, 3}@. Will never print more than 3 refutable shapes, the tail is @@ -98,21 +98,21 @@ substitution to the vectors before printing them out (see function `pprOne' in -- | Extract and assigns pretty names to constraint variables with refutable -- shapes. -prettifyRefuts :: Delta -> DIdEnv SDoc -> DIdEnv (SDoc, [PmAltCon]) -prettifyRefuts delta = listToUDFM_Directly . map attach_refuts . udfmToList +prettifyRefuts :: Nabla -> DIdEnv SDoc -> DIdEnv (SDoc, [PmAltCon]) +prettifyRefuts nabla = listToUDFM_Directly . map attach_refuts . udfmToList where - attach_refuts (u, sdoc) = (u, (sdoc, lookupRefuts delta u)) + attach_refuts (u, sdoc) = (u, (sdoc, lookupRefuts nabla u)) -type PmPprM a = RWS Delta () (DIdEnv SDoc, [SDoc]) a +type PmPprM a = RWS Nabla () (DIdEnv SDoc, [SDoc]) a -- Try nice names p,q,r,s,t before using the (ugly) t_i nameList :: [SDoc] nameList = map text ["p","q","r","s","t"] ++ [ text ('t':show u) | u <- [(0 :: Int)..] ] -runPmPpr :: Delta -> PmPprM a -> (a, DIdEnv SDoc) -runPmPpr delta m = case runRWS m delta (emptyDVarEnv, nameList) of +runPmPpr :: Nabla -> PmPprM a -> (a, DIdEnv SDoc) +runPmPpr nabla m = case runRWS m nabla (emptyDVarEnv, nameList) of (a, (renamings, _), _) -> (a, renamings) -- | Allocates a new, clean name for the given 'Id' if it doesn't already have @@ -129,8 +129,8 @@ getCleanName x = do checkRefuts :: Id -> PmPprM (Maybe SDoc) -- the clean name if it has negative info attached checkRefuts x = do - delta <- ask - case lookupRefuts delta x of + nabla <- ask + case lookupRefuts nabla x of [] -> pure Nothing -- Will just be a wildcard later on _ -> Just <$> getCleanName x @@ -144,8 +144,8 @@ pprPmVar :: PprPrec -> Id -> PmPprM SDoc -- The useful information in the latter case is the constructor that we missed, -- not the types of the wildcards in the places that aren't matched as a result. pprPmVar prec x = do - delta <- ask - case lookupSolution delta x of + nabla <- ask + case lookupSolution nabla x of Just (alt, _tvs, args) -> pprPmAltCon prec alt args Nothing -> fromMaybe typed_wildcard <$> checkRefuts x where @@ -160,24 +160,24 @@ pprPmVar prec x = do pprPmAltCon :: PprPrec -> PmAltCon -> [Id] -> PmPprM SDoc pprPmAltCon _prec (PmAltLit l) _ = pure (ppr l) pprPmAltCon prec (PmAltConLike cl) args = do - delta <- ask - pprConLike delta prec cl args + nabla <- ask + pprConLike nabla prec cl args -pprConLike :: Delta -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc -pprConLike delta _prec cl args - | Just pm_expr_list <- pmExprAsList delta (PmAltConLike cl) args +pprConLike :: Nabla -> PprPrec -> ConLike -> [Id] -> PmPprM SDoc +pprConLike nabla _prec cl args + | Just pm_expr_list <- pmExprAsList nabla (PmAltConLike cl) args = case pm_expr_list of NilTerminated list -> brackets . fsep . punctuate comma <$> mapM (pprPmVar appPrec) list WcVarTerminated pref x -> parens . fcat . punctuate colon <$> mapM (pprPmVar appPrec) (toList pref ++ [x]) -pprConLike _delta _prec (RealDataCon con) args +pprConLike _nabla _prec (RealDataCon con) args | isUnboxedTupleDataCon con , let hash_parens doc = text "(#" <+> doc <+> text "#)" = hash_parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args | isTupleDataCon con = parens . fsep . punctuate comma <$> mapM (pprPmVar appPrec) args -pprConLike _delta prec cl args +pprConLike _nabla prec cl args | conLikeIsInfix cl = case args of [x, y] -> do x' <- pprPmVar funPrec x y' <- pprPmVar funPrec y @@ -202,11 +202,11 @@ data PmExprList -- ending in a wildcard variable x (of list type). Should be pretty-printed as -- (1:2:_). -- * @pmExprAsList [] == Just ('NilTerminated' [])@ -pmExprAsList :: Delta -> PmAltCon -> [Id] -> Maybe PmExprList -pmExprAsList delta = go_con [] +pmExprAsList :: Nabla -> PmAltCon -> [Id] -> Maybe PmExprList +pmExprAsList nabla = go_con [] where go_var rev_pref x - | Just (alt, _tvs, args) <- lookupSolution delta x + | Just (alt, _tvs, args) <- lookupSolution nabla x = go_con rev_pref alt args go_var rev_pref x | Just pref <- nonEmpty (reverse rev_pref) ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -15,6 +15,7 @@ Author: George Karachalias module GHC.HsToCore.PmCheck.Types ( -- * Representations for Literals and AltCons PmLit(..), PmLitValue(..), PmAltCon(..), pmLitType, pmAltConType, + isPmAltConMatchStrict, pmAltConImplBangs, -- ** Equality on 'PmAltCon's PmEquality(..), eqPmAltCon, @@ -35,8 +36,8 @@ module GHC.HsToCore.PmCheck.Types ( setIndirectSDIE, setEntrySDIE, traverseSDIE, -- * The pattern match oracle - VarInfo(..), TmState(..), TyState(..), Delta(..), - Deltas(..), initDeltas, liftDeltasM + BotInfo(..), VarInfo(..), TmState(..), TyState(..), Nabla(..), + Nablas(..), initNablas, liftNablasM ) where #include "HsVersions.h" @@ -226,6 +227,19 @@ pmAltConType :: PmAltCon -> [Type] -> Type pmAltConType (PmAltLit lit) _arg_tys = ASSERT( null _arg_tys ) pmLitType lit pmAltConType (PmAltConLike con) arg_tys = conLikeResTy con arg_tys +-- | Is a match on this constructor forcing the match variable? +-- True of data constructors, literals and pattern synonyms (#17357), but not of +-- newtypes. +-- See Note [Coverage checking Newtype matches] in "GHC.HsToCore.PmCheck.Oracle". +isPmAltConMatchStrict :: PmAltCon -> Bool +isPmAltConMatchStrict PmAltLit{} = True +isPmAltConMatchStrict (PmAltConLike PatSynCon{}) = True -- #17357 +isPmAltConMatchStrict (PmAltConLike (RealDataCon dc)) = not (isNewDataCon dc) + +pmAltConImplBangs :: PmAltCon -> [HsImplBang] +pmAltConImplBangs PmAltLit{} = [] +pmAltConImplBangs (PmAltConLike con) = conLikeImplBangs con + {- Note [Undecidable Equality for PmAltCons] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Equality on overloaded literals is undecidable in the general case. Consider @@ -477,6 +491,13 @@ instance Outputable a => Outputable (Shared a) where instance Outputable a => Outputable (SharedDIdEnv a) where ppr (SDIE env) = ppr env +-- | See 'vi_bot'. +data BotInfo + = IsBot + | IsNotBot + | MaybeBot + deriving Eq + -- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These -- entries are possibly shared when we figure out that two variables must be -- equal, thus represent the same set of values. @@ -531,6 +552,13 @@ data VarInfo -- because files like Cabal's `LicenseId` define relatively huge enums -- that lead to quadratic or worse behavior. + , vi_bot :: BotInfo + -- ^ Can this variable be ⊥? Models (mutually contradicting) @x ~ ⊥@ and + -- @x ≁ ⊥@ constraints. E.g. + -- * 'MaybeBot': Don't know; Neither @x ~ ⊥@ nor @x ≁ ⊥@. + -- * 'IsBot': @x ~ ⊥@ + -- * 'IsNotBot': @x ≁ ⊥@ + , vi_cache :: !PossibleMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of -- possible constructors of each COMPLETE set. So, if it's not in here, we @@ -538,14 +566,19 @@ data VarInfo -- to recognise completion of a COMPLETE set efficiently for large enums. } +instance Outputable BotInfo where + ppr MaybeBot = empty + ppr IsBot = text "~⊥" + ppr IsNotBot = text "≁⊥" + -- | Not user-facing. instance Outputable TmState where ppr (TmSt state reps) = ppr state $$ ppr reps -- | Not user-facing. instance Outputable VarInfo where - ppr (VI ty pos neg cache) - = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr cache])) + ppr (VI ty pos neg bot cache) + = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr bot, ppr cache])) -- | Initial state of the term oracle. initTmState :: TmState @@ -563,37 +596,38 @@ instance Outputable TyState where initTyState :: TyState initTyState = TySt emptyBag --- | An inert set of canonical (i.e. mutually compatible) term and type --- constraints. -data Delta = MkDelta { delta_ty_st :: TyState -- Type oracle; things like a~Int - , delta_tm_st :: TmState } -- Term oracle; things like x~Nothing +-- | A normalised refinement type ∇ (\"nabla\"), comprised of an inert set of +-- canonical (i.e. mutually compatible) term and type constraints that form the +-- refinement type's predicate. +data Nabla = MkNabla { nabla_ty_st :: TyState -- Type oracle; things like a~Int + , nabla_tm_st :: TmState } -- Term oracle; things like x~Nothing --- | An initial delta that is always satisfiable -initDelta :: Delta -initDelta = MkDelta initTyState initTmState +-- | An initial nabla that is always satisfiable +initNabla :: Nabla +initNabla = MkNabla initTyState initTmState -instance Outputable Delta where - ppr delta = hang (text "Delta") 2 $ vcat [ +instance Outputable Nabla where + ppr nabla = hang (text "Nabla") 2 $ vcat [ -- intentionally formatted this way enable the dev to comment in only -- the info she needs - ppr (delta_tm_st delta), - ppr (delta_ty_st delta) + ppr (nabla_tm_st nabla), + ppr (nabla_ty_st nabla) ] --- | A disjunctive bag of 'Delta's, representing a refinement type. -newtype Deltas = MkDeltas (Bag Delta) +-- | A disjunctive bag of 'Nabla's, representing a refinement type. +newtype Nablas = MkNablas (Bag Nabla) -initDeltas :: Deltas -initDeltas = MkDeltas (unitBag initDelta) +initNablas :: Nablas +initNablas = MkNablas (unitBag initNabla) -instance Outputable Deltas where - ppr (MkDeltas deltas) = ppr deltas +instance Outputable Nablas where + ppr (MkNablas nablas) = ppr nablas -instance Semigroup Deltas where - MkDeltas l <> MkDeltas r = MkDeltas (l `unionBags` r) +instance Semigroup Nablas where + MkNablas l <> MkNablas r = MkNablas (l `unionBags` r) -instance Monoid Deltas where - mempty = MkDeltas emptyBag +instance Monoid Nablas where + mempty = MkNablas emptyBag -liftDeltasM :: Monad m => (Delta -> m (Maybe Delta)) -> Deltas -> m Deltas -liftDeltasM f (MkDeltas ds) = MkDeltas . catBagMaybes <$> (traverse f ds) +liftNablasM :: Monad m => (Nabla -> m (Maybe Nabla)) -> Nablas -> m Nablas +liftNablasM f (MkNablas ds) = MkNablas . catBagMaybes <$> (traverse f ds) ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs-boot ===================================== @@ -2,8 +2,8 @@ module GHC.HsToCore.PmCheck.Types where import GHC.Data.Bag -data Delta +data Nabla -newtype Deltas = MkDeltas (Bag Delta) +newtype Nablas = MkNablas (Bag Nabla) -initDeltas :: Deltas +initNablas :: Nablas ===================================== compiler/GHC/Tc/Types.hs ===================================== @@ -106,7 +106,7 @@ import GHC.Tc.Types.Origin import GHC.Types.Annotations import GHC.Core.InstEnv import GHC.Core.FamInstEnv -import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Deltas) +import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Nablas) import GHC.Data.IOEnv import GHC.Types.Name.Reader import GHC.Types.Name @@ -324,9 +324,9 @@ data DsLclEnv = DsLclEnv { dsl_loc :: RealSrcSpan, -- To put in pattern-matching error msgs -- See Note [Note [Long-distance information] in "GHC.HsToCore.PmCheck" - -- The set of reaching values Deltas is augmented as we walk inwards, + -- The set of reaching values Nablas is augmented as we walk inwards, -- refined through each pattern match in turn - dsl_deltas :: Deltas + dsl_nablas :: Nablas } -- Inside [| |] brackets, the desugarer looks ===================================== testsuite/tests/pmcheck/should_compile/T10183.hs ===================================== @@ -0,0 +1,22 @@ +{-# LANGUAGE GADTs, DataKinds, TypeOperators, UnicodeSyntax #-} + +module Foo where + +import GHC.TypeLits + +data List l t where + Nil ∷ List 0 t + (:-) ∷ t → List l t → List (l+1) t + +head' ∷ (1<=l) ⇒ List l t → t +head' (x :- _) = x + +data T a where + TT :: T Bool + TF :: T Int + +f :: T Bool -> Bool +f TT = True + +g :: (a ~ Bool) => T a -> Bool +g TT = True ===================================== testsuite/tests/pmcheck/should_compile/T17340.stderr ===================================== @@ -7,6 +7,10 @@ T17340.hs:19:4: warning: [-Wredundant-bang-patterns] Pattern match has redundant bang In an equation for ‘g’: g x = ... +T17340.hs:23:9: warning: [-Wredundant-bang-patterns] + Pattern match has redundant bang + In an equation for ‘h’: h x = ... + T17340.hs:27:4: warning: [-Wredundant-bang-patterns] Pattern match has redundant bang In an equation for ‘k’: k _ = ... ===================================== testsuite/tests/pmcheck/should_compile/T17378.hs ===================================== @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE EmptyCase #-} +module Lib where + +import Data.Type.Equality +import Data.Functor.Identity +import Data.Void + +f :: a :~: Int -> a :~: Bool -> () +f !_ x = case x of {} + +g :: Identity (a :~: Int) -> a :~: Bool -> () +g (Identity _) Refl = () + +data SMaybe a = SNothing + | SJust !a + +-- | Exhaustive. Note how in addition to @{(a,b) | b /~ True}@, the value set +-- @{(a,b) | y /~ SNothing, b ~ True}@ flows into the next equation, but @y@ is +-- no longer in scope. Normally, we have no way of matching on that without a +-- wildcard match, but in this case we refute @y ~ SJust z@ by unleashing type +-- evidence saying that @z@ must be 'Void' by matching on 'Refl'. +h :: forall a. a :~: Void -> Bool -> () +h _ True | let y = undefined :: SMaybe a, SNothing <- y = () +h Refl False = () ===================================== testsuite/tests/pmcheck/should_compile/T17725.hs ===================================== @@ -0,0 +1,10 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +module Lib where + +newtype IInt = IInt Int + +f :: IInt -> Bool -> () +f !(IInt _) True = () +f (IInt 42) True = () +f _ _ = () ===================================== testsuite/tests/pmcheck/should_compile/T17725.stderr ===================================== @@ -0,0 +1,4 @@ + +T17725.hs:9:1: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f (IInt 42) True = ... ===================================== testsuite/tests/pmcheck/should_compile/T17729.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_GHC -fforce-recomp -Wincomplete-patterns #-} + +incomplete :: Maybe a -> Bool +incomplete ma = case (ma, ()) of + (Nothing, _) -> False + +{-# COMPLETE Pat #-} +pattern Pat :: a -> b -> (a, b) +pattern Pat a b = (a, b) + +main :: IO () +main = print $ incomplete (Just ()) ===================================== testsuite/tests/pmcheck/should_compile/T17729.stderr ===================================== @@ -0,0 +1,4 @@ + +T17729.hs:5:17: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In a case alternative: Patterns not matched: ((Just _), ()) ===================================== testsuite/tests/pmcheck/should_compile/T17977.stderr ===================================== @@ -0,0 +1,10 @@ + +T17977.hs:31:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: + Patterns not matched: + SZ SZ SZ _ + SZ SZ (SS _) _ + SZ (SS _) SZ _ + SZ (SS _) (SS _) _ + ... ===================================== testsuite/tests/pmcheck/should_compile/T18273.hs ===================================== @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -fforce-recomp -Wincomplete-patterns #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} + +module Bug where + +import Data.Kind +import Data.Void + +type SFalse = SBool 'False +type STrue = SBool 'True + +data SBool :: Bool -> Type where + SFalse :: SFalse + STrue :: STrue + +type family F (b :: Bool) :: Type where + F 'False = Void + F 'True = () + +data T (b :: Bool) + = MkT1 + | MkT2 !(F b) + +ex :: SBool b -> T b -> () +ex sb t = + case t of + MkT1 -> () + MkT2 f -> + case sb of + STrue -> f + +ex2 :: SBool b -> T b -> () +ex2 sb t = + case t of + MkT2 f -> + case sb of + STrue -> f + MkT1 -> () ===================================== testsuite/tests/pmcheck/should_compile/T18341.hs ===================================== @@ -0,0 +1,24 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} + +module Lib where + +import GHC.Exts + +data T = MkT !Int {-# UNPACK #-} !Int Int# + +f :: T -> () +f (MkT _ _ _) | False = () -- inaccessible +f (MkT !_ _ _) | False = () -- redundant, not only inaccessible! +f _ = () + +g :: T -> () +g (MkT _ _ _) | False = () -- inaccessible +g (MkT _ !_ _) | False = () -- redundant, not only inaccessible! +g _ = () + +h :: T -> () +h (MkT _ _ _) | False = () -- inaccessible +h (MkT _ _ !_) | False = () -- redundant, not only inaccessible! +h _ = () ===================================== testsuite/tests/pmcheck/should_compile/T18341.stderr ===================================== @@ -0,0 +1,24 @@ + +T18341.hs:12:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘f’: f (MkT _ _ _) | False = ... + +T18341.hs:13:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘f’: f (MkT !_ _ _) | False = ... + +T18341.hs:17:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘g’: g (MkT _ _ _) | False = ... + +T18341.hs:18:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘g’: g (MkT _ !_ _) | False = ... + +T18341.hs:22:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match has inaccessible right hand side + In an equation for ‘h’: h (MkT _ _ _) | False = ... + +T18341.hs:23:18: warning: [-Woverlapping-patterns (in -Wdefault)] + Pattern match is redundant + In an equation for ‘h’: h (MkT _ _ !_) | False = ... ===================================== testsuite/tests/pmcheck/should_compile/T18670.hs ===================================== @@ -0,0 +1,16 @@ +{-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE TypeOperators #-} + +module Lib where + +import Data.Type.Equality + +data T a where + TInt :: T Int + TBool :: T Bool + +f :: T a -> a :~: Int -> () +f TInt Refl = () ===================================== testsuite/tests/pmcheck/should_compile/T18670.stderr ===================================== @@ -0,0 +1,4 @@ + +T18670.hs:16:1: warning: [-Wincomplete-patterns (in -Wextra)] + Pattern match(es) are non-exhaustive + In an equation for ‘f’: Patterns not matched: TBool _ ===================================== testsuite/tests/pmcheck/should_compile/all.T ===================================== @@ -36,6 +36,8 @@ test('T9951b', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T9951', [], compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T10183', [], compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T11303', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns +RTS -M1G -RTS']) test('T11276', collect_compiler_stats('bytes allocated',10), compile, @@ -108,12 +110,18 @@ test('T17357', expect_broken(17357), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17376', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17378', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17465', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17646', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17703', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17725', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T17729', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17783', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T17977', collect_compiler_stats('bytes allocated',10), compile, @@ -122,12 +130,18 @@ test('T17977b', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18049', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18273', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) +test('T18341', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18478', collect_compiler_stats('bytes allocated',10), compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18533', normal, compile, ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) test('T18572', normal, compile, ['-fwarn-incomplete-patterns -fwarn-incomplete-uni-patterns -fwarn-overlapping-patterns']) +test('T18670', normal, compile, + ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns']) # Other tests test('pmc001', [], compile, View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95455982df1ef15c6d4585a7d3e93b5e75146a07...3777be14e104f040b826762f5ab42a8b898d85ae -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/95455982df1ef15c6d4585a7d3e93b5e75146a07...3777be14e104f040b826762f5ab42a8b898d85ae You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 13:59:49 2020 From: gitlab at gitlab.haskell.org (Marge Bot) Date: Fri, 11 Sep 2020 09:59:49 -0400 Subject: [Git][ghc/ghc][master] 3 commits: Define TICKY_TICKY when compiling cmm RTS files. Message-ID: <5f5b82d51d474_80b3f848678c644115770ad@gitlab.haskell.org.mail> Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1bd28931 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Define TICKY_TICKY when compiling cmm RTS files. - - - - - 15e67801 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Fix typos in TICKY_TICKY symbol names. - - - - - 8a5a91cb by David Himmelstrup at 2020-09-11T09:59:43-04:00 Enable TICKY_TICKY for debug builds when building with makefiles. - - - - - 5 changed files: - hadrian/src/Settings/Packages.hs - includes/Cmm.h - includes/stg/Ticky.h - mk/ways.mk - rts/Ticky.c Changes: ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -279,7 +279,8 @@ rtsPackageArgs = package rts ? do , arg $ "-DFS_NAMESPACE=rts" , arg $ "-DCOMPILING_RTS" , notM targetSupportsSMP ? arg "-DNOSMP" - , way `elem` [debug, debugDynamic] ? arg "-DTICKY_TICKY" + , way `elem` [debug, debugDynamic] ? pure [ "-DTICKY_TICKY" + , "-optc-DTICKY_TICKY"] , Profiling `wayUnit` way ? arg "-DPROFILING" , Threaded `wayUnit` way ? arg "-DTHREADED_RTS" , notM targetSupportsSMP ? pure [ "-DNOSMP" ===================================== includes/Cmm.h ===================================== @@ -660,7 +660,11 @@ #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1) #define TICK_ENT_DYN_IND() TICK_BUMP(ENT_DYN_IND_ctr) -#define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr) +// ENT_DYN_THK_ctr doesn't exist anymore. Could be ENT_DYN_THK_SINGLE_ctr or +// ENT_DYN_THK_MANY_ctr +// #define TICK_ENT_DYN_THK() TICK_BUMP(ENT_DYN_THK_ctr) +#define TICK_ENT_DYN_THK() + #define TICK_ENT_VIA_NODE() TICK_BUMP(ENT_VIA_NODE_ctr) #define TICK_ENT_STATIC_IND() TICK_BUMP(ENT_STATIC_IND_ctr) #define TICK_ENT_PERM_IND() TICK_BUMP(ENT_PERM_IND_ctr) ===================================== includes/stg/Ticky.h ===================================== @@ -199,18 +199,23 @@ EXTERN StgInt RET_UNBOXED_TUP_hst[TICKY_BIN_COUNT] INIT({0}); TICKY_TICKY is defined or not. */ #if !defined(CMINUSMINUS) +#if defined(TICKY_TICKY) #define TICK_BUMP_BY(ctr,n) ctr = (StgInt) ctr + n +#else +#define TICK_BUMP_BY(ctr,n) /* nothing */ +#endif + #define TICK_BUMP(ctr) TICK_BUMP_BY(ctr,1) -#define TICK_ALLOC_PRIM(x,y,z) -#define TICK_UPD_OLD_IND() -#define TICK_UPD_NEW_IND() -#define TICK_UPD_SQUEEZED() -#define TICK_ALLOC_HEAP_NOCTR(bytes) -#define TICK_GC_FAILED_PROMOTION() -#define TICK_ALLOC_TSO() -#define TICK_ALLOC_STACK(g) -#define TICK_ALLOC_UP_THK(g,s) -#define TICK_ALLOC_SE_THK(g,s) +#define TICK_ALLOC_PRIM(x,y,z) // FIXME: update counter +#define TICK_UPD_OLD_IND() TICK_BUMP(UPD_OLD_IND_ctr) +#define TICK_UPD_NEW_IND() TICK_BUMP(UPD_NEW_IND_ctr) +#define TICK_UPD_SQUEEZED() TICK_BUMP(UPD_SQUEEZED_ctr) +#define TICK_ALLOC_HEAP_NOCTR(bytes) // FIXME: update counter +#define TICK_GC_FAILED_PROMOTION() // FIXME: update counter +#define TICK_ALLOC_TSO() // FIXME: update counter +#define TICK_ALLOC_STACK(g) // FIXME: update counter +#define TICK_ALLOC_UP_THK(g,s) // FIXME: update counter +#define TICK_ALLOC_SE_THK(g,s) // FIXME: update counter #endif ===================================== mk/ways.mk ===================================== @@ -70,7 +70,7 @@ WAY_thr_l_HC_OPTS= -static -optc-DTHREADED_RTS -eventlog # Way 'debug': WAY_debug_NAME=debug -WAY_debug_HC_OPTS= -static -optc-DDEBUG -ticky -DTICKY_TICKY -eventlog +WAY_debug_HC_OPTS= -static -optc-DDEBUG -ticky -DTICKY_TICKY -optc-DTICKY_TICKY -eventlog # Way 'debug_p': WAY_debug_p_NAME=debug profiled @@ -110,7 +110,7 @@ WAY_thr_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DTHREADED_RTS -optc-DDEBUG -event # Way 'debug_dyn': WAY_debug_dyn_NAME=debug_dyn -WAY_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DDEBUG -ticky -DTICKY_TICKY -eventlog +WAY_debug_dyn_HC_OPTS=-fPIC -dynamic -optc-DDEBUG -ticky -DTICKY_TICKY -optc-DTICKY_TICKY -eventlog # Way 'l_dyn': WAY_l_dyn_NAME=event logging dynamic ===================================== rts/Ticky.c ===================================== @@ -261,7 +261,7 @@ PrintTickyInfo(void) * * This of course refers to the -ticky version that uses PERM_INDs to * determine the number of closures entered 0/1/>1. KSW 1999-04. */ - COND_PR_CTR(ENT_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"E!NT_PERM_IND_ctr requires +RTS -Z"); + COND_PR_CTR(ENT_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"ENT_PERM_IND_ctr requires +RTS -Z"); PR_CTR(ENT_AP_ctr); PR_CTR(ENT_PAP_ctr); @@ -334,10 +334,10 @@ PrintTickyInfo(void) PR_CTR(UPD_NEW_IND_ctr); /* see comment on ENT_PERM_IND_ctr */ - COND_PR_CTR(UPD_NEW_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"U!PD_NEW_PERM_IND_ctr requires +RTS -Z"); + COND_PR_CTR(UPD_NEW_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"UPD_NEW_PERM_IND_ctr requires +RTS -Z"); PR_CTR(UPD_OLD_IND_ctr); /* see comment on ENT_PERM_IND_ctr */ - COND_PR_CTR(UPD_OLD_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"U!PD_OLD_PERM_IND_ctr requires +RTS -Z"); + COND_PR_CTR(UPD_OLD_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == false,"UPD_OLD_PERM_IND_ctr requires +RTS -Z"); PR_CTR(GC_SEL_ABANDONED_ctr); PR_CTR(GC_SEL_MINOR_ctr); View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3777be14e104f040b826762f5ab42a8b898d85ae...8a5a91cb67e8c4e2558031c04efccf3c378ba254 -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3777be14e104f040b826762f5ab42a8b898d85ae...8a5a91cb67e8c4e2558031c04efccf3c378ba254 You're receiving this email because of your account on gitlab.haskell.org. -------------- next part -------------- An HTML attachment was scrubbed... URL: From gitlab at gitlab.haskell.org Fri Sep 11 14:00:22 2020 From: gitlab at gitlab.haskell.org (Sebastian Graf) Date: Fri, 11 Sep 2020 10:00:22 -0400 Subject: [Git][ghc/ghc][wip/T14422] 4 commits: Define TICKY_TICKY when compiling cmm RTS files. Message-ID: <5f5b82f6d6552_80b3f849bfd62a4115794a4@gitlab.haskell.org.mail> Sebastian Graf pushed to branch wip/T14422 at Glasgow Haskell Compiler / GHC Commits: 1bd28931 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Define TICKY_TICKY when compiling cmm RTS files. - - - - - 15e67801 by David Himmelstrup at 2020-09-11T09:59:43-04:00 Fix typos in TICKY_TICKY symbol names. - - - - - 8a5a91cb by David Himmelstrup at 2020-09-11T09:59:43-04:00 Enable TICKY_TICKY for debug builds when building with makefiles. - - - - - 8fdf97c4 by Sebastian Graf at 2020-09-11T16:00:10+02:00 PmCheck: Disattach COMPLETE pragma lookup from TyCons By not attaching COMPLETE pragmas with a particular TyCon and instead assume that every COMPLETE pragma is applicable everywhere, we can drastically simplify the logic that tries to initialise available COMPLETE sets of a variable during the pattern-match checking process, as well as fixing a few bugs. Of course, we have to make sure not to report any of the ill-typed/unrelated COMPLETE sets, which came up in a few regression tests. In doing so, we fix #17207, #18277 and #14422. There was a metric decrease in #18478 by ~20%. Metric Decrease: T18478 - - - - - 27 changed files: - compiler/GHC/Driver/Types.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/PmCheck/Oracle.hs - compiler/GHC/HsToCore/PmCheck/Types.hs - compiler/GHC/Iface/Load.hs - compiler/GHC/Iface/Make.hs - compiler/GHC/Iface/Syntax.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/IfaceToCore.hs - compiler/GHC/IfaceToCore.hs-boot - compiler/GHC/Tc/Gen/Bind.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Env.hs - docs/users_guide/exts/pragmas.rst - hadrian/src/Settings/Packages.hs - includes/Cmm.h - includes/stg/Ticky.h - mk/ways.mk - rts/Ticky.c - testsuite/tests/pmcheck/complete_sigs/completesig15.hs → testsuite/tests/pmcheck/complete_sigs/T14422.hs - + testsuite/tests/pmcheck/complete_sigs/T18277.hs - testsuite/tests/pmcheck/complete_sigs/all.T - testsuite/tests/pmcheck/complete_sigs/completesig04.hs - testsuite/tests/pmcheck/complete_sigs/completesig04.stderr - − testsuite/tests/pmcheck/complete_sigs/completesig15.stderr - testsuite/tests/pmcheck/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Types.hs ===================================== @@ -61,7 +61,7 @@ module GHC.Driver.Types ( lookupIfaceByModule, emptyPartialModIface, emptyFullModIface, lookupHptByModule, PackageInstEnv, PackageFamInstEnv, PackageRuleBase, - PackageCompleteMatchMap, + PackageCompleteMatches, mkSOName, mkHsSOName, soExt, @@ -146,8 +146,7 @@ module GHC.Driver.Types ( handleFlagWarnings, printOrThrowWarnings, -- * COMPLETE signature - CompleteMatch(..), CompleteMatchMap, - mkCompleteMatchMap, extendCompleteMatchMap, + ConLikeSet, CompleteMatch, CompleteMatches, -- * Exstensible Iface fields ExtensibleFields(..), FieldName, @@ -735,7 +734,7 @@ lookupIfaceByModule hpt pit mod -- of its own, but it doesn't seem worth the bother. hptCompleteSigs :: HscEnv -> [CompleteMatch] -hptCompleteSigs = hptAllThings (md_complete_sigs . hm_details) +hptCompleteSigs = hptAllThings (md_complete_matches . hm_details) -- | Find all the instance declarations (of classes and families) from -- the Home Package Table filtered by the provided predicate function. @@ -1093,7 +1092,7 @@ data ModIface_ (phase :: ModIfacePhase) -- itself) but imports some trustworthy modules from its own -- package (which does require its own package be trusted). -- See Note [Trust Own Package] in GHC.Rename.Names - mi_complete_sigs :: [IfaceCompleteMatch], + mi_complete_matches :: [IfaceCompleteMatch], mi_doc_hdr :: Maybe HsDocString, -- ^ Module header. @@ -1184,7 +1183,7 @@ instance Binary ModIface where mi_hpc = hpc_info, mi_trust = trust, mi_trust_pkg = trust_pkg, - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1230,7 +1229,7 @@ instance Binary ModIface where put_ bh hpc_info put_ bh trust put_ bh trust_pkg - put_ bh complete_sigs + put_ bh complete_matches lazyPut bh doc_hdr lazyPut bh decl_docs lazyPut bh arg_docs @@ -1263,7 +1262,7 @@ instance Binary ModIface where hpc_info <- get bh trust <- get bh trust_pkg <- get bh - complete_sigs <- get bh + complete_matches <- get bh doc_hdr <- lazyGet bh decl_docs <- lazyGet bh arg_docs <- lazyGet bh @@ -1287,7 +1286,7 @@ instance Binary ModIface where mi_trust = trust, mi_trust_pkg = trust_pkg, -- And build the cached values - mi_complete_sigs = complete_sigs, + mi_complete_matches = complete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -1332,7 +1331,7 @@ emptyPartialModIface mod mi_hpc = False, mi_trust = noIfaceTrustInfo, mi_trust_pkg = False, - mi_complete_sigs = [], + mi_complete_matches = [], mi_doc_hdr = Nothing, mi_decl_docs = emptyDeclDocMap, mi_arg_docs = emptyArgDocMap, @@ -1388,7 +1387,7 @@ data ModDetails md_rules :: ![CoreRule], -- ^ Domain may include 'Id's from other modules md_anns :: ![Annotation], -- ^ Annotations present in this module: currently -- they only annotate things also declared in this module - md_complete_sigs :: [CompleteMatch] + md_complete_matches :: [CompleteMatch] -- ^ Complete match pragmas for this module } @@ -1401,7 +1400,7 @@ emptyModDetails md_rules = [], md_fam_insts = [], md_anns = [], - md_complete_sigs = [] } + md_complete_matches = [] } -- | Records the modules directly imported by a module for extracting e.g. -- usage information, and also to give better error message @@ -1464,7 +1463,7 @@ data ModGuts -- ^ Files to be compiled with the C compiler mg_warns :: !Warnings, -- ^ Warnings declared in the module mg_anns :: [Annotation], -- ^ Annotations declared in this module - mg_complete_sigs :: [CompleteMatch], -- ^ Complete Matches + mg_complete_matches :: [CompleteMatch], -- ^ Complete Matches mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module mg_modBreaks :: !(Maybe ModBreaks), -- ^ Breakpoints for the module @@ -2685,7 +2684,7 @@ type PackageRuleBase = RuleBase type PackageInstEnv = InstEnv type PackageFamInstEnv = FamInstEnv type PackageAnnEnv = AnnEnv -type PackageCompleteMatchMap = CompleteMatchMap +type PackageCompleteMatches = CompleteMatches -- | Information about other packages that we have slurped in by reading -- their interface files @@ -2747,8 +2746,8 @@ data ExternalPackageState -- from all the external-package modules eps_ann_env :: !PackageAnnEnv, -- ^ The total 'AnnEnv' accumulated -- from all the external-package modules - eps_complete_matches :: !PackageCompleteMatchMap, - -- ^ The total 'CompleteMatchMap' accumulated + eps_complete_matches :: !PackageCompleteMatches, + -- ^ The total 'CompleteMatches' accumulated -- from all the external-package modules eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- ^ The family instances accumulated from external @@ -3204,83 +3203,14 @@ byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) ------------------------------------------- +type ConLikeSet = UniqDSet ConLike + -- | A list of conlikes which represents a complete pattern match. -- These arise from @COMPLETE@ signatures. +-- See also Note [Implementation of COMPLETE pragmas]. +type CompleteMatch = ConLikeSet --- See Note [Implementation of COMPLETE signatures] -data CompleteMatch = CompleteMatch { - completeMatchConLikes :: [Name] - -- ^ The ConLikes that form a covering family - -- (e.g. Nothing, Just) - , completeMatchTyCon :: Name - -- ^ The TyCon that they cover (e.g. Maybe) - } - -instance Outputable CompleteMatch where - ppr (CompleteMatch cl ty) = text "CompleteMatch:" <+> ppr cl - <+> dcolon <+> ppr ty - --- | A map keyed by the 'completeMatchTyCon' which has type Name. - --- See Note [Implementation of COMPLETE signatures] -type CompleteMatchMap = UniqFM Name [CompleteMatch] - -mkCompleteMatchMap :: [CompleteMatch] -> CompleteMatchMap -mkCompleteMatchMap = extendCompleteMatchMap emptyUFM - -extendCompleteMatchMap :: CompleteMatchMap -> [CompleteMatch] - -> CompleteMatchMap -extendCompleteMatchMap = foldl' insertMatch - where - insertMatch :: CompleteMatchMap -> CompleteMatch -> CompleteMatchMap - insertMatch ufm c@(CompleteMatch _ t) = addToUFM_C (++) ufm t [c] - -{- -Note [Implementation of COMPLETE signatures] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -A COMPLETE signature represents a set of conlikes (i.e., constructors or -pattern synonyms) such that if they are all pattern-matched against in a -function, it gives rise to a total function. An example is: - - newtype Boolean = Boolean Int - pattern F, T :: Boolean - pattern F = Boolean 0 - pattern T = Boolean 1 - {-# COMPLETE F, T #-} - - -- This is a total function - booleanToInt :: Boolean -> Int - booleanToInt F = 0 - booleanToInt T = 1 - -COMPLETE sets are represented internally in GHC with the CompleteMatch data -type. For example, {-# COMPLETE F, T #-} would be represented as: - - CompleteMatch { complateMatchConLikes = [F, T] - , completeMatchTyCon = Boolean } - -Note that GHC was able to infer the completeMatchTyCon (Boolean), but for the -cases in which it's ambiguous, you can also explicitly specify it in the source -language by writing this: - - {-# COMPLETE F, T :: Boolean #-} - -For efficiency purposes, GHC collects all of the CompleteMatches that it knows -about into a CompleteMatchMap, which is a map that is keyed by the -completeMatchTyCon. In other words, you could have a multiple COMPLETE sets -for the same TyCon: - - {-# COMPLETE F, T1 :: Boolean #-} - {-# COMPLETE F, T2 :: Boolean #-} - -And looking up the values in the CompleteMatchMap associated with Boolean -would give you [CompleteMatch [F, T1] Boolean, CompleteMatch [F, T2] Boolean]. -dsGetCompleteMatches in GHC.HsToCore.Quote accomplishes this lookup. - -Also see Note [Typechecking Complete Matches] in GHC.Tc.Gen.Bind for a more detailed -explanation for how GHC ensures that all the conlikes in a COMPLETE set are -consistent. --} +type CompleteMatches = [CompleteMatch] -- | Foreign language of the phase if the phase deals with a foreign code phaseForeignLanguage :: Phase -> Maybe ForeignSrcLang ===================================== compiler/GHC/HsToCore.hs ===================================== @@ -228,7 +228,7 @@ deSugar hsc_env mg_modBreaks = modBreaks, mg_safe_haskell = safe_mode, mg_trust_pkg = imp_trust_own_pkg imports, - mg_complete_sigs = complete_matches, + mg_complete_matches = complete_matches, mg_doc_hdr = doc_hdr, mg_decl_docs = decl_docs, mg_arg_docs = arg_docs ===================================== compiler/GHC/HsToCore/Monad.hs ===================================== @@ -88,7 +88,6 @@ import GHC.Driver.Ppr import GHC.Utils.Error import GHC.Utils.Panic import GHC.Data.FastString -import GHC.Types.Unique.FM ( lookupWithDefaultUFM_Directly ) import GHC.Types.Literal ( mkLitString ) import GHC.Types.CostCentre.State @@ -210,13 +209,15 @@ mkDsEnvsFromTcGbl :: MonadIO m -> m (DsGblEnv, DsLclEnv) mkDsEnvsFromTcGbl hsc_env msg_var tcg_env = do { cc_st_var <- liftIO $ newIORef newCostCentreState + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env this_mod = tcg_mod tcg_env type_env = tcg_type_env tcg_env rdr_env = tcg_rdr_env tcg_env fam_inst_env = tcg_fam_inst_env tcg_env - complete_matches = hptCompleteSigs hsc_env - ++ tcg_complete_matches tcg_env + complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ tcg_complete_matches tcg_env -- from the current module + ++ eps_complete_matches eps -- from imports ; return $ mkDsEnvs dflags this_mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches } @@ -239,13 +240,15 @@ initDsWithModGuts :: HscEnv -> ModGuts -> DsM a -> IO (Messages, Maybe a) initDsWithModGuts hsc_env guts thing_inside = do { cc_st_var <- newIORef newCostCentreState ; msg_var <- newIORef emptyMessages + ; eps <- liftIO $ hscEPS hsc_env ; let dflags = hsc_dflags hsc_env type_env = typeEnvFromEntities ids (mg_tcs guts) (mg_fam_insts guts) rdr_env = mg_rdr_env guts fam_inst_env = mg_fam_inst_env guts this_mod = mg_module guts - complete_matches = hptCompleteSigs hsc_env - ++ mg_complete_sigs guts + complete_matches = hptCompleteSigs hsc_env -- from the home package + ++ mg_complete_matches guts -- from the current module + ++ eps_complete_matches eps -- from imports bindsToIds (NonRec v _) = [v] bindsToIds (Rec binds) = map fst binds @@ -281,7 +284,7 @@ initTcDsForSolver thing_inside thing_inside } mkDsEnvs :: DynFlags -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv - -> IORef Messages -> IORef CostCentreState -> [CompleteMatch] + -> IORef Messages -> IORef CostCentreState -> CompleteMatches -> (DsGblEnv, DsLclEnv) mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var complete_matches @@ -290,7 +293,6 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var if_lenv = mkIfLclEnv mod (text "GHC error in desugarer lookup in" <+> ppr mod) NotBoot real_span = realSrcLocSpan (mkRealSrcLoc (moduleNameFS (moduleName mod)) 1 1) - completeMatchMap = mkCompleteMatchMap complete_matches gbl_env = DsGblEnv { ds_mod = mod , ds_fam_inst_env = fam_inst_env , ds_if_env = (if_genv, if_lenv) @@ -299,7 +301,7 @@ mkDsEnvs dflags mod rdr_env type_env fam_inst_env msg_var cc_st_var (mkHomeUnitFromFlags dflags) rdr_env , ds_msgs = msg_var - , ds_complete_matches = completeMatchMap + , ds_complete_matches = complete_matches , ds_cc_st = cc_st_var } lcl_env = DsLclEnv { dsl_meta = emptyNameEnv @@ -533,18 +535,9 @@ dsGetFamInstEnvs dsGetMetaEnv :: DsM (NameEnv DsMetaVal) dsGetMetaEnv = do { env <- getLclEnv; return (dsl_meta env) } --- | The @COMPLETE@ pragmas provided by the user for a given `TyCon`. -dsGetCompleteMatches :: TyCon -> DsM [CompleteMatch] -dsGetCompleteMatches tc = do - eps <- getEps - env <- getGblEnv - -- We index into a UniqFM from Name -> elt, for tyCon it holds that - -- getUnique (tyConName tc) == getUnique tc. So we lookup using the - -- unique directly instead. - let lookup_completes ufm = lookupWithDefaultUFM_Directly ufm [] (getUnique tc) - eps_matches_list = lookup_completes $ eps_complete_matches eps - env_matches_list = lookup_completes $ ds_complete_matches env - return $ eps_matches_list ++ env_matches_list +-- | The @COMPLETE@ pragmas that are in scope. +dsGetCompleteMatches :: DsM CompleteMatches +dsGetCompleteMatches = ds_complete_matches <$> getGblEnv dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal) dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (dsl_meta env) name) } ===================================== compiler/GHC/HsToCore/PmCheck/Oracle.hs ===================================== @@ -67,13 +67,13 @@ import GHC.Core.TyCo.Rep import GHC.Core.Type import GHC.Tc.Solver (tcNormalise, tcCheckSatisfiability) import GHC.Core.Unify (tcMatchTy) -import GHC.Tc.Types (completeMatchConLikes) import GHC.Core.Coercion import GHC.Utils.Monad hiding (foldlM) import GHC.HsToCore.Monad hiding (foldlM) import GHC.Tc.Instance.Family import GHC.Core.FamInstEnv +import Control.Applicative ((<|>)) import Control.Monad (guard, mzero, when) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Strict @@ -81,7 +81,6 @@ import Data.Bifunctor (second) import Data.Either (partitionEithers) import Data.Foldable (foldlM, minimumBy, toList) import Data.List (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ord (comparing) import qualified Data.Semigroup as Semigroup import Data.Tuple (swap) @@ -106,11 +105,114 @@ mkPmId ty = getUniqueM >>= \unique -> ----------------------------------------------- -- * Caching possible matches of a COMPLETE set -markMatched :: ConLike -> PossibleMatches -> PossibleMatches -markMatched _ NoPM = NoPM -markMatched con (PM ms) = PM (del_one_con con <$> ms) +-- See Note [Implementation of COMPLETE pragmas] + +-- | Traverse the COMPLETE sets of 'ResidualCompleteMatches'. +trvRcm :: Applicative f => (ConLikeSet -> f ConLikeSet) -> ResidualCompleteMatches -> f ResidualCompleteMatches +trvRcm f (RCM vanilla pragmas) = RCM <$> traverse f vanilla + <*> traverse (traverse f) pragmas +-- | Update the COMPLETE sets of 'ResidualCompleteMatches'. +updRcm :: (ConLikeSet -> ConLikeSet) -> ResidualCompleteMatches -> ResidualCompleteMatches +updRcm f (RCM vanilla pragmas) = RCM (f <$> vanilla) (fmap f <$> pragmas) + +-- | A pseudo-'CompleteMatch' for the vanilla complete set of the given data +-- 'TyCon'. +-- Ex.: @vanillaCompleteMatchTC 'Maybe' ==> Just ("Maybe", {'Just','Nothing'})@ +vanillaCompleteMatchTC :: TyCon -> Maybe ConLikeSet +vanillaCompleteMatchTC tc = + let -- | TYPE acts like an empty data type on the term-level (#14086), but + -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a + -- special case. + mb_dcs | tc == tYPETyCon = Just [] + | otherwise = tyConDataCons_maybe tc + in mkUniqDSet . map RealDataCon <$> mb_dcs + +-- | Initialise from 'dsGetCompleteMatches' (containing all COMPLETE pragmas) +-- if the given 'ResidualCompleteMatches' were empty. +addCompleteMatches :: ResidualCompleteMatches -> DsM ResidualCompleteMatches +addCompleteMatches (RCM v Nothing) = RCM v . Just <$> dsGetCompleteMatches +addCompleteMatches rcm = pure rcm + +-- | Adds the declared 'CompleteMatches' from COMPLETE pragmas, as well as the +-- vanilla data defn if it is a 'DataCon'. +addConLikeMatches :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addConLikeMatches (RealDataCon dc) rcm = addTyConMatches (dataConTyCon dc) rcm +addConLikeMatches (PatSynCon _) rcm = addCompleteMatches rcm + +-- | Adds +-- * the 'CompleteMatches' from COMPLETE pragmas +-- * and the /vanilla/ 'CompleteMatch' from the data 'TyCon' +-- to the 'ResidualCompleteMatches', if not already present. +addTyConMatches :: TyCon -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +addTyConMatches tc rcm = add_tc_match <$> addCompleteMatches rcm where - del_one_con = flip delOneFromUniqDSet + -- | Add the vanilla COMPLETE set from the data defn, if any. But only if + -- it's not already present. + add_tc_match rcm + = rcm{rcm_vanilla = rcm_vanilla rcm <|> vanillaCompleteMatchTC tc} + +markMatched :: ConLike -> ResidualCompleteMatches -> DsM ResidualCompleteMatches +markMatched cl rcm = do + rcm' <- addConLikeMatches cl rcm + pure $ updRcm (flip delOneFromUniqDSet cl) rcm' + +{- +Note [Implementation of COMPLETE pragmas] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +A COMPLETE set represents a set of conlikes (i.e., constructors or +pattern synonyms) such that if they are all pattern-matched against in a +function, it gives rise to a total function. An example is: + + newtype Boolean = Boolean Int + pattern F, T :: Boolean + pattern F = Boolean 0 + pattern T = Boolean 1 + {-# COMPLETE F, T #-} + + -- This is a total function + booleanToInt :: Boolean -> Int + booleanToInt F = 0 + booleanToInt T = 1 + +COMPLETE sets are represented internally in GHC a set of 'ConLike's. For +example, the pragma {-# COMPLETE F, T #-} would be represented as: + + {F, T} + +GHC collects all COMPLETE pragmas from the current module and from imports +into a field in the DsM environment, which can be accessed with +dsGetCompleteMatches from "GHC.HsToCore.Monad". +Currently, COMPLETE pragmas can't be orphans (e.g. at least one ConLike must +also be defined in the module of the pragma) and do not impact recompilation +checking (#18675). + +The pattern-match checker will then initialise each variable's 'VarInfo' with +*all* imported COMPLETE sets (in 'GHC.HsToCore.PmCheck.Oracle.addCompleteMatches'), +well-typed or not, into a 'ResidualCompleteMatches'. The trick is that a +COMPLETE set that is ill-typed for that match variable could never be written by +the user! And we make sure not to report any ill-typed COMPLETE sets when +formatting 'Nabla's for warnings in 'provideEvidence'. + +A 'ResidualCompleteMatches' is a list of all COMPLETE sets, minus the ConLikes +we know a particular variable can't be (through negative constructor constraints + at x /~ K@ or a failed attempt at instantiating that ConLike during inhabitation +testing). If *any* of the COMPLETE sets become empty, we know that the match +was exhaustive. + +We assume that a COMPLETE set is non-empty if for one of its ConLikes +we fail to 'guessConLikeUnivTyArgsFromResTy'. That accounts for ill-typed +COMPLETE sets. So why don't we simply prune those ill-typed COMPLETE sets from +'ResidualCompleteMatches'? The answer is that additional type constraints might +make more COMPLETE sets applicable! Example: + + f :: a -> a :~: Boolean -> () + f x Refl | T <- x = () + | F <- x = () + +If we eagerly prune {F,T} from the residual matches of @x@, then we don't see +that the match in the guards of @f@ is exhaustive, where the COMPLETE set +applies due to refined type information. +-} --------------------------------------------------- -- * Instantiating constructors, types and evidence @@ -493,7 +595,7 @@ tyOracle (TySt inert) cts -- | A 'SatisfiabilityCheck' based on new type-level constraints. -- Returns a new 'Nabla' if the new constraints are compatible with existing -- ones. Doesn't bother calling out to the type oracle if the bag of new type --- constraints was empty. Will only recheck 'PossibleMatches' in the term oracle +-- constraints was empty. Will only recheck 'ResidualCompleteMatches' in the term oracle -- for emptiness if the first argument is 'True'. tyIsSatisfiable :: Bool -> Bag PredType -> SatisfiabilityCheck tyIsSatisfiable recheck_complete_sets new_ty_cs = SC $ \nabla -> @@ -545,10 +647,10 @@ of a PatSynCon (Just42,[]), this solution is incomparable to both Nothing and Just. Hence we retain the info in vi_neg, which eventually allows us to detect the complete pattern match. -The Pos/Neg invariant extends to vi_cache, which stores essentially positive -information. We make sure that vi_neg and vi_cache never overlap. This isn't -strictly necessary since vi_cache is just a cache, so doesn't need to be -accurate: Every suggestion of a possible ConLike from vi_cache might be +The Pos/Neg invariant extends to vi_rcm, which stores essentially positive +information. We make sure that vi_neg and vi_rcm never overlap. This isn't +strictly necessary since vi_rcm is just a cache, so doesn't need to be +accurate: Every suggestion of a possible ConLike from vi_rcm might be refutable by the type oracle anyway. But it helps to maintain sanity while debugging traces. @@ -569,7 +671,7 @@ The term oracle state is never obviously (i.e., without consulting the type oracle) contradictory. This implies a few invariants: * Whenever vi_pos overlaps with vi_neg according to 'eqPmAltCon', we refute. This is implied by the Note [Pos/Neg invariant]. -* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_cache to +* Whenever vi_neg subsumes a COMPLETE set, we refute. We consult vi_rcm to detect this, but we could just compare whole COMPLETE sets to vi_neg every time, if it weren't for performance. @@ -625,13 +727,16 @@ tmIsSatisfiable new_tm_cs = SC $ \nabla -> runMaybeT $ foldlM addTmCt nabla new_ ----------------------- -- * Looking up VarInfo +emptyRCM :: ResidualCompleteMatches +emptyRCM = RCM Nothing Nothing + emptyVarInfo :: Id -> VarInfo -- We could initialise @bot@ to @Just False@ in case of an unlifted type here, -- but it's cleaner to let the user of the constraint solver take care of this. -- After all, there are also strict fields, the unliftedness of which isn't -- evident in the type. So treating unlifted types here would never be -- sufficient anyway. -emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot NoPM +emptyVarInfo x = VI (idType x) [] emptyPmAltConSet MaybeBot emptyRCM lookupVarInfo :: TmState -> Id -> VarInfo -- (lookupVarInfo tms x) tells what we know about 'x' @@ -657,85 +762,6 @@ lookupVarInfoNT ts x = case lookupVarInfo ts x of | isNewDataCon dc = Just y go _ = Nothing -initPossibleMatches :: TyState -> VarInfo -> DsM VarInfo -initPossibleMatches ty_st vi at VI{ vi_ty = ty, vi_cache = NoPM } = do - -- New evidence might lead to refined info on ty, in turn leading to discovery - -- of a COMPLETE set. - res <- pmTopNormaliseType ty_st ty - let ty' = normalisedSourceType res - case splitTyConApp_maybe ty' of - Nothing -> pure vi{ vi_ty = ty' } - Just (tc, [_]) - | tc == tYPETyCon - -- TYPE acts like an empty data type on the term-level (#14086), but - -- it is a PrimTyCon, so tyConDataCons_maybe returns Nothing. Hence a - -- special case. - -> pure vi{ vi_ty = ty', vi_cache = PM (pure emptyUniqDSet) } - Just (tc, tc_args) -> do - -- See Note [COMPLETE sets on data families] - (tc_rep, tc_fam) <- case tyConFamInst_maybe tc of - Just (tc_fam, _) -> pure (tc, tc_fam) - Nothing -> do - env <- dsGetFamInstEnvs - let (tc_rep, _tc_rep_args, _co) = tcLookupDataFamInst env tc tc_args - pure (tc_rep, tc) - -- Note that the common case here is tc_rep == tc_fam - let mb_rdcs = map RealDataCon <$> tyConDataCons_maybe tc_rep - let rdcs = maybeToList mb_rdcs - -- NB: tc_fam, because COMPLETE sets are associated with the parent data - -- family TyCon - pragmas <- dsGetCompleteMatches tc_fam - let fams = mapM dsLookupConLike . completeMatchConLikes - pscs <- mapM fams pragmas - -- pprTrace "initPossibleMatches" (ppr ty $$ ppr ty' $$ ppr tc_rep <+> ppr tc_fam <+> ppr tc_args $$ ppr (rdcs ++ pscs)) (return ()) - case NonEmpty.nonEmpty (rdcs ++ pscs) of - Nothing -> pure vi{ vi_ty = ty' } -- Didn't find any COMPLETE sets - Just cs -> pure vi{ vi_ty = ty', vi_cache = PM (mkUniqDSet <$> cs) } -initPossibleMatches _ vi = pure vi - -{- Note [COMPLETE sets on data families] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -User-defined COMPLETE sets involving data families are attached to the family -TyCon, whereas the built-in COMPLETE set is attached to a data family instance's -representation TyCon. This matters for COMPLETE sets involving both DataCons -and PatSyns (from #17207): - - data family T a - data family instance T () = A | B - pattern C = B - {-# COMPLETE A, C #-} - f :: T () -> () - f A = () - f C = () - -The match on A is actually wrapped in a CoPat, matching impedance between T () -and its representation TyCon, which we translate as - at x | let y = x |> co, A <- y@ in PmCheck. - -Which TyCon should we use for looking up the COMPLETE set? The representation -TyCon from the match on A would only reveal the built-in COMPLETE set, while the -data family TyCon would only give the user-defined one. But when initialising -the PossibleMatches for a given Type, we want to do so only once, because -merging different COMPLETE sets after the fact is very complicated and possibly -inefficient. - -So in fact, we just *drop* the coercion arising from the CoPat when handling -handling the constraint @y ~ x |> co@ in addCoreCt, just equating @y ~ x at . -We then handle the fallout in initPossibleMatches, which has to get a hand at -both the representation TyCon tc_rep and the parent data family TyCon tc_fam. -It considers three cases after having established that the Type is a TyConApp: - -1. The TyCon is a vanilla data type constructor -2. The TyCon is tc_rep -3. The TyCon is tc_fam - -1. is simple and subsumed by the handling of the other two. -We check for case 2. by 'tyConFamInst_maybe' and get the tc_fam out. -Otherwise (3.), we try to lookup the data family instance at that particular -type to get out the tc_rep. In case 1., this will just return the original -TyCon, so tc_rep = tc_fam afterwards. --} - ------------------------------------------------ -- * Exported utility functions querying 'Nabla' @@ -898,11 +924,7 @@ addNotConCt :: Nabla -> Id -> PmAltCon -> MaybeT DsM Nabla addNotConCt _ _ (PmAltConLike (RealDataCon dc)) | isNewDataCon dc = mzero -- (3) in Note [Coverage checking Newtype matches] addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do - -- For good performance, it's important to initPossibleMatches here. - -- Otherwise we can't mark nalt as matched later on, incurring unnecessary - -- inhabitation tests for nalt. - vi@(VI _ pos neg _ pm) <- lift $ initPossibleMatches (nabla_ty_st nabla) - (lookupVarInfo ts x) + let vi@(VI _ pos neg _ rcm) = lookupVarInfo ts x -- 1. Bail out quickly when nalt contradicts a solution let contradicts nalt (cl, _tvs, _args) = eqPmAltCon cl nalt == Equal guard (not (any (contradicts nalt) pos)) @@ -918,9 +940,11 @@ addNotConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x nalt = do let vi1 = vi{ vi_neg = neg', vi_bot = IsNotBot } -- 3. Make sure there's at least one other possible constructor vi2 <- case nalt of - PmAltConLike cl - -> ensureInhabited nabla vi1{ vi_cache = markMatched cl pm } - _ -> pure vi1 + PmAltConLike cl -> do + rcm' <- lift (markMatched cl rcm) + ensureInhabited nabla vi1{ vi_rcm = rcm' } + _ -> + pure vi1 pure nabla{ nabla_tm_st = TmSt (setEntrySDIE env x vi2) reps } hasRequiredTheta :: PmAltCon -> Bool @@ -964,13 +988,15 @@ storing required arguments along with the PmAltConLike in 'vi_neg'. -- its result type. Rather easy for DataCons, but not so much for PatSynCons. -- See Note [Pattern synonym result type] in "GHC.Core.PatSyn". guessConLikeUnivTyArgsFromResTy :: FamInstEnvs -> Type -> ConLike -> Maybe [Type] -guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon _) = do +guessConLikeUnivTyArgsFromResTy env res_ty (RealDataCon dc) = do (tc, tc_args) <- splitTyConApp_maybe res_ty -- Consider data families: In case of a DataCon, we need to translate to -- the representation TyCon. For PatSyns, they are relative to the data -- family TyCon, so we don't need to translate them. - let (_, tc_args', _) = tcLookupDataFamInst env tc tc_args - Just tc_args' + let (rep_tc, tc_args', _) = tcLookupDataFamInst env tc tc_args + if rep_tc == dataConTyCon dc + then Just tc_args' + else Nothing guessConLikeUnivTyArgsFromResTy _ res_ty (PatSynCon ps) = do -- We are successful if we managed to instantiate *every* univ_tv of con. -- This is difficult and bound to fail in some cases, see @@ -999,7 +1025,7 @@ addNotBotCt nabla at MkNabla{ nabla_tm_st = TmSt env reps } x = do -- | Returns (Just vi) if at least one member of each ConLike in the COMPLETE -- set satisfies the oracle -- --- Internally uses and updates the ConLikeSets in vi_cache. +-- Internally uses and updates the ConLikeSets in vi_rcm. -- -- NB: Does /not/ filter each ConLikeSet with the oracle; members may -- remain that do not statisfy it. This lazy approach just @@ -1008,17 +1034,32 @@ ensureInhabited :: Nabla -> VarInfo -> MaybeT DsM VarInfo ensureInhabited nabla vi = case vi_bot vi of MaybeBot -> pure vi -- The |-Bot rule from the paper IsBot -> pure vi - IsNotBot -> lift (initPossibleMatches (nabla_ty_st nabla) vi) >>= inst_complete_sets + IsNotBot -> lift (add_matches vi) >>= inst_complete_sets where + add_matches :: VarInfo -> DsM VarInfo + add_matches vi = do + res <- pmTopNormaliseType (nabla_ty_st nabla) (vi_ty vi) + rcm <- case reprTyCon_maybe (normalisedSourceType res) of + Just tc -> addTyConMatches tc (vi_rcm vi) + Nothing -> addCompleteMatches (vi_rcm vi) + pure vi{ vi_rcm = rcm } + + reprTyCon_maybe :: Type -> Maybe TyCon + reprTyCon_maybe ty = case splitTyConApp_maybe ty of + Nothing -> Nothing + Just (tc, _args) -> case tyConFamInst_maybe tc of + Nothing -> Just tc + Just (tc_fam, _) -> Just tc_fam + -- | This is the |-Inst rule from the paper (section 4.5). Tries to -- find an inhabitant in every complete set by instantiating with one their -- constructors. If there is any complete set where we can't find an -- inhabitant, the whole thing is uninhabited. + -- See also Note [Implementation of COMPLETE pragmas]. inst_complete_sets :: VarInfo -> MaybeT DsM VarInfo - inst_complete_sets vi at VI{ vi_cache = NoPM } = pure vi - inst_complete_sets vi at VI{ vi_cache = PM ms } = do - ms <- traverse (\cs -> inst_complete_set vi cs (uniqDSetToList cs)) ms - pure vi{ vi_cache = PM ms } + inst_complete_sets vi at VI{ vi_rcm = rcm } = do + rcm' <- trvRcm (\cls -> inst_complete_set vi cls (uniqDSetToList cls)) rcm + pure vi{ vi_rcm = rcm' } inst_complete_set :: VarInfo -> ConLikeSet -> [ConLike] -> MaybeT DsM ConLikeSet -- (inst_complete_set cs cls) iterates over cls, deleting from cs @@ -1053,7 +1094,7 @@ ensureInhabited nabla vi = case vi_bot vi of ] -- | Checks if every 'VarInfo' in the term oracle has still an inhabited --- 'vi_cache', considering the current type information in 'Nabla'. +-- 'vi_rcm', considering the current type information in 'Nabla'. -- This check is necessary after having matched on a GADT con to weed out -- impossible matches. ensureAllInhabited :: Nabla -> DsM (Maybe Nabla) @@ -1112,7 +1153,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- Do the same for negative info let add_refut nabla nalt = addNotConCt nabla y nalt nabla_neg <- foldlM add_refut nabla_pos (pmAltConSetElems (vi_neg vi_x)) - -- vi_cache will be updated in addNotConCt, so we are good to + -- vi_rcm will be updated in addNotConCt, so we are good to -- go! pure nabla_neg @@ -1124,7 +1165,7 @@ equate nabla at MkNabla{ nabla_tm_st = TmSt env reps } x y -- See Note [TmState invariants]. addConCt :: Nabla -> Id -> PmAltCon -> [TyVar] -> [Id] -> MaybeT DsM Nabla addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do - let VI ty pos neg bot cache = lookupVarInfo ts x + let VI ty pos neg bot rcm = lookupVarInfo ts x -- First try to refute with a negative fact guard (not (elemPmAltConSet alt neg)) -- Then see if any of the other solutions (remember: each of them is an @@ -1143,7 +1184,8 @@ addConCt nabla at MkNabla{ nabla_tm_st = ts@(TmSt env reps) } x alt tvs args = do MaybeT $ addPmCts nabla (listToBag ty_cts `unionBags` listToBag tm_cts) Nothing -> do let pos' = (alt, tvs, args):pos - let nabla_with bot = nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot cache)) reps} + let nabla_with bot = + nabla{ nabla_tm_st = TmSt (setEntrySDIE env x (VI ty pos' neg bot rcm)) reps} -- Do (2) in Note [Coverage checking Newtype matches] case (alt, args) of (PmAltConLike (RealDataCon dc), [y]) | isNewDataCon dc -> @@ -1575,7 +1617,7 @@ provideEvidence = go try_instantiate :: Id -> [Id] -> Int -> Nabla -> DsM [Nabla] -- Convention: x binds the outer constructor in the chain, y the inner one. try_instantiate x xs n nabla = do - (_src_ty, dcs, core_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) + (_src_ty, dcs, rep_ty) <- tntrGuts <$> pmTopNormaliseType (nabla_ty_st nabla) (idType x) let build_newtype (x, nabla) (_ty, dc, arg_ty) = do y <- lift $ mkPmId arg_ty -- Newtypes don't have existentials (yet?!), so passing an empty @@ -1587,11 +1629,13 @@ provideEvidence = go Just (y, newty_nabla) -> do -- Pick a COMPLETE set and instantiate it (n at max). Take care of ⊥. let vi = lookupVarInfo (nabla_tm_st newty_nabla) y - vi <- initPossibleMatches (nabla_ty_st newty_nabla) vi - mb_cls <- pickMinimalCompleteSet newty_nabla (vi_cache vi) + rcm <- case splitTyConApp_maybe rep_ty of + Nothing -> pure (vi_rcm vi) + Just (tc, _) -> addTyConMatches tc (vi_rcm vi) + mb_cls <- pickMinimalCompleteSet rep_ty rcm case uniqDSetToList <$> mb_cls of Just cls -> do - nablas <- instantiate_cons y core_ty xs n newty_nabla cls + nablas <- instantiate_cons y rep_ty xs n newty_nabla cls if null nablas && vi_bot vi /= IsNotBot then go xs n newty_nabla -- bot is still possible. Display a wildcard! else pure nablas @@ -1633,13 +1677,15 @@ provideEvidence = go other_cons_nablas <- instantiate_cons x ty xs (n - length con_nablas) nabla cls pure (con_nablas ++ other_cons_nablas) -pickMinimalCompleteSet :: Nabla -> PossibleMatches -> DsM (Maybe ConLikeSet) -pickMinimalCompleteSet _ NoPM = pure Nothing --- TODO: First prune sets with type info in nabla. But this is good enough for --- now and less costly. See #17386. -pickMinimalCompleteSet _ (PM clss) = do - tracePm "pickMinimalCompleteSet" (ppr $ NonEmpty.toList clss) - pure (Just (minimumBy (comparing sizeUniqDSet) clss)) +pickMinimalCompleteSet :: Type -> ResidualCompleteMatches -> DsM (Maybe ConLikeSet) +pickMinimalCompleteSet ty rcm = do + env <- dsGetFamInstEnvs + pure $ case filter (all (is_valid env) . uniqDSetToList) (getRcm rcm) of + [] -> Nothing + clss' -> Just (minimumBy (comparing sizeUniqDSet) clss') + where + is_valid :: FamInstEnvs -> ConLike -> Bool + is_valid env cl = isJust (guessConLikeUnivTyArgsFromResTy env ty cl) -- | Finds a representant of the semantic equality class of the given @e at . -- Which is the @x@ of a @let x = e'@ constraint (with @e@ semantically ===================================== compiler/GHC/HsToCore/PmCheck/Types.hs ===================================== @@ -24,8 +24,8 @@ module GHC.HsToCore.PmCheck.Types ( literalToPmLit, negatePmLit, overloadPmLit, pmLitAsStringLit, coreExprAsPmLit, - -- * Caching partially matched COMPLETE sets - ConLikeSet, PossibleMatches(..), + -- * Caching residual COMPLETE sets + ConLikeSet, ResidualCompleteMatches(..), getRcm, -- * PmAltConSet PmAltConSet, emptyPmAltConSet, isEmptyPmAltConSet, elemPmAltConSet, @@ -69,10 +69,10 @@ import GHC.Builtin.Names import GHC.Builtin.Types import GHC.Builtin.Types.Prim import GHC.Tc.Utils.TcType (evVarPred) +import GHC.Driver.Types (ConLikeSet) import Numeric (fromRat) import Data.Foldable (find) -import qualified Data.List.NonEmpty as NonEmpty import Data.Ratio import qualified Data.Semigroup as Semi @@ -415,21 +415,32 @@ instance Outputable PmAltCon where instance Outputable PmEquality where ppr = text . show -type ConLikeSet = UniqDSet ConLike +-- | A data type that caches for the 'VarInfo' of @x@ the results of querying +-- 'dsGetCompleteMatches' and then striking out all occurrences of @K@ for +-- which we already know @x /~ K@ from these sets. +-- +-- For motivation, see Section 5.3 in Lower Your Guards. +-- See also Note [Implementation of COMPLETE pragmas] +data ResidualCompleteMatches + = RCM + { rcm_vanilla :: !(Maybe ConLikeSet) + -- ^ The residual set for the vanilla COMPLETE set from the data defn. + -- Tracked separately from 'rcm_pragmas', because it might only be + -- known much later (when we have enough type information to see the 'TyCon' + -- of the match), or not at all even. Until that happens, it is 'Nothing'. + , rcm_pragmas :: !(Maybe [ConLikeSet]) + -- ^ The residual sets for /all/ COMPLETE sets from pragmas that are + -- visible when compiling this module. Querying that set with + -- 'dsGetCompleteMatches' requires 'DsM', so we initialise it with 'Nothing' + -- until first needed in a 'DsM' context. + } --- | A data type caching the results of 'completeMatchConLikes' with support for --- deletion of constructors that were already matched on. -data PossibleMatches - = PM (NonEmpty.NonEmpty ConLikeSet) - -- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE set - -- 'NonEmpty' because the empty case would mean that the type has no COMPLETE - -- set at all, for which we have 'NoPM'. - | NoPM - -- ^ No COMPLETE set for this type (yet). Think of overloaded literals. +getRcm :: ResidualCompleteMatches -> [ConLikeSet] +getRcm (RCM vanilla pragmas) = maybeToList vanilla ++ fromMaybe [] pragmas -instance Outputable PossibleMatches where - ppr (PM cs) = ppr (NonEmpty.toList cs) - ppr NoPM = text "" +instance Outputable ResidualCompleteMatches where + -- formats as "[{Nothing,Just},{P,Q}]" + ppr rcm = ppr (getRcm rcm) -- | Either @Indirect x@, meaning the value is represented by that of @x@, or -- an @Entry@ containing containing the actual value it represents. @@ -516,8 +527,8 @@ data TmState -- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@, -- and negative ('vi_neg') facts, like "x is not (:)". --- Also caches the type ('vi_ty'), the 'PossibleMatches' of a COMPLETE set --- ('vi_cache'). +-- Also caches the type ('vi_ty'), the 'ResidualCompleteMatches' of a COMPLETE set +-- ('vi_rcm'). -- -- Subject to Note [The Pos/Neg invariant] in "GHC.HsToCore.PmCheck.Oracle". data VarInfo @@ -559,7 +570,7 @@ data VarInfo -- * 'IsBot': @x ~ ⊥@ -- * 'IsNotBot': @x ≁ ⊥@ - , vi_cache :: !PossibleMatches + , vi_rcm :: !ResidualCompleteMatches -- ^ A cache of the associated COMPLETE sets. At any time a superset of -- possible constructors of each COMPLETE set. So, if it's not in here, we -- can't possibly match on it. Complementary to 'vi_neg'. We still need it ===================================== compiler/GHC/Iface/Load.hs ===================================== @@ -38,7 +38,7 @@ import GHC.Prelude import {-# SOURCE #-} GHC.IfaceToCore ( tcIfaceDecl, tcIfaceRules, tcIfaceInst, tcIfaceFamInst - , tcIfaceAnnotations, tcIfaceCompleteSigs ) + , tcIfaceAnnotations, tcIfaceCompleteMatches ) import GHC.Driver.Session import GHC.Driver.Backend @@ -479,7 +479,7 @@ loadInterface doc_str mod from ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) ; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface) ; new_eps_anns <- tcIfaceAnnotations (mi_anns iface) - ; new_eps_complete_sigs <- tcIfaceCompleteSigs (mi_complete_sigs iface) + ; new_eps_complete_matches <- tcIfaceCompleteMatches (mi_complete_matches iface) ; let { final_iface = iface { mi_decls = panic "No mi_decls in PIT", @@ -509,9 +509,7 @@ loadInterface doc_str mod from eps_rule_base = extendRuleBaseList (eps_rule_base eps) new_eps_rules, eps_complete_matches - = extendCompleteMatchMap - (eps_complete_matches eps) - new_eps_complete_sigs, + = eps_complete_matches eps ++ new_eps_complete_matches, eps_inst_env = extendInstEnvList (eps_inst_env eps) new_eps_insts, eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps) @@ -1037,9 +1035,8 @@ initExternalPackageState home_unit eps_fam_inst_env = emptyFamInstEnv, eps_rule_base = mkRuleBase builtinRules', -- Initialise the EPS rule pool with the built-in rules - eps_mod_fam_inst_env - = emptyModuleEnv, - eps_complete_matches = emptyUFM, + eps_mod_fam_inst_env = emptyModuleEnv, + eps_complete_matches = [], eps_ann_env = emptyAnnEnv, eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0 , n_insts_in = 0, n_insts_out = 0 @@ -1181,7 +1178,7 @@ pprModIface iface at ModIface{ mi_final_exts = exts } , ppr (mi_warns iface) , pprTrustInfo (mi_trust iface) , pprTrustPkg (mi_trust_pkg iface) - , vcat (map ppr (mi_complete_sigs iface)) + , vcat (map ppr (mi_complete_matches iface)) , text "module header:" $$ nest 2 (ppr (mi_doc_hdr iface)) , text "declaration docs:" $$ nest 2 (ppr (mi_decl_docs iface)) , text "arg docs:" $$ nest 2 (ppr (mi_arg_docs iface)) ===================================== compiler/GHC/Iface/Make.hs ===================================== @@ -57,6 +57,7 @@ import GHC.Types.Avail import GHC.Types.Name.Reader import GHC.Types.Name.Env import GHC.Types.Name.Set +import GHC.Types.Unique.DSet import GHC.Unit import GHC.Utils.Error import GHC.Utils.Outputable @@ -220,7 +221,7 @@ mkIface_ hsc_env md_anns = anns, md_types = type_env, md_exports = exports, - md_complete_sigs = complete_sigs } + md_complete_matches = complete_matches } -- NB: notice that mkIface does not look at the bindings -- only at the TypeEnv. The previous Tidy phase has -- put exactly the info into the TypeEnv that we want @@ -256,7 +257,7 @@ mkIface_ hsc_env iface_fam_insts = map famInstToIfaceFamInst fam_insts trust_info = setSafeMode safe_mode annotations = map mkIfaceAnnotation anns - icomplete_sigs = map mkIfaceCompleteSig complete_sigs + icomplete_matches = map mkIfaceCompleteMatch complete_matches ModIface { mi_module = this_mod, @@ -285,7 +286,7 @@ mkIface_ hsc_env mi_hpc = isHpcUsed hpc_info, mi_trust = trust_info, mi_trust_pkg = pkg_trust_req, - mi_complete_sigs = icomplete_sigs, + mi_complete_matches = icomplete_matches, mi_doc_hdr = doc_hdr, mi_decl_docs = decl_docs, mi_arg_docs = arg_docs, @@ -322,8 +323,9 @@ mkIface_ hsc_env ************************************************************************ -} -mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch -mkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc +mkIfaceCompleteMatch :: CompleteMatch -> IfaceCompleteMatch +mkIfaceCompleteMatch cls = + IfaceCompleteMatch (map conLikeName (uniqDSetToList cls)) {- ===================================== compiler/GHC/Iface/Syntax.hs ===================================== @@ -324,11 +324,11 @@ data IfaceAnnotation type IfaceAnnTarget = AnnTarget OccName -data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName +newtype IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] instance Outputable IfaceCompleteMatch where - ppr (IfaceCompleteMatch cls ty) = text "COMPLETE" <> colon <+> ppr cls - <+> dcolon <+> ppr ty + ppr (IfaceCompleteMatch cls) = text "COMPLETE" <> colon <+> ppr cls + @@ -2481,8 +2481,8 @@ instance Binary IfaceTyConParent where return $ IfDataInstance ax pr ty instance Binary IfaceCompleteMatch where - put_ bh (IfaceCompleteMatch cs ts) = put_ bh cs >> put_ bh ts - get bh = IfaceCompleteMatch <$> get bh <*> get bh + put_ bh (IfaceCompleteMatch cs) = put_ bh cs + get bh = IfaceCompleteMatch <$> get bh {- @@ -2638,7 +2638,7 @@ instance NFData IfaceConAlt where IfaceLitAlt lit -> lit `seq` () instance NFData IfaceCompleteMatch where - rnf (IfaceCompleteMatch f1 f2) = rnf f1 `seq` rnf f2 + rnf (IfaceCompleteMatch f1) = rnf f1 instance NFData IfaceRule where rnf (IfaceRule f1 f2 f3 f4 f5 f6 f7 f8) = ===================================== compiler/GHC/Iface/Tidy.hs ===================================== @@ -143,7 +143,7 @@ mkBootModDetailsTc hsc_env tcg_patsyns = pat_syns, tcg_insts = insts, tcg_fam_insts = fam_insts, - tcg_complete_matches = complete_sigs, + tcg_complete_matches = complete_matches, tcg_mod = this_mod } = -- This timing isn't terribly useful since the result isn't forced, but @@ -151,13 +151,13 @@ mkBootModDetailsTc hsc_env Err.withTiming dflags (text "CoreTidy"<+>brackets (ppr this_mod)) (const ()) $ - return (ModDetails { md_types = type_env' - , md_insts = insts' - , md_fam_insts = fam_insts - , md_rules = [] - , md_anns = [] - , md_exports = exports - , md_complete_sigs = complete_sigs + return (ModDetails { md_types = type_env' + , md_insts = insts' + , md_fam_insts = fam_insts + , md_rules = [] + , md_anns = [] + , md_exports = exports + , md_complete_matches = complete_matches }) where dflags = hsc_dflags hsc_env @@ -346,22 +346,22 @@ three places this is actioned: -} tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails) -tidyProgram hsc_env (ModGuts { mg_module = mod - , mg_exports = exports - , mg_rdr_env = rdr_env - , mg_tcs = tcs - , mg_insts = cls_insts - , mg_fam_insts = fam_insts - , mg_binds = binds - , mg_patsyns = patsyns - , mg_rules = imp_rules - , mg_anns = anns - , mg_complete_sigs = complete_sigs - , mg_deps = deps - , mg_foreign = foreign_stubs - , mg_foreign_files = foreign_files - , mg_hpc_info = hpc_info - , mg_modBreaks = modBreaks +tidyProgram hsc_env (ModGuts { mg_module = mod + , mg_exports = exports + , mg_rdr_env = rdr_env + , mg_tcs = tcs + , mg_insts = cls_insts + , mg_fam_insts = fam_insts + , mg_binds = binds + , mg_patsyns = patsyns + , mg_rules = imp_rules + , mg_anns = anns + , mg_complete_matches = complete_matches + , mg_deps = deps + , mg_foreign = foreign_stubs + , mg_foreign_files = foreign_files + , mg_hpc_info = hpc_info + , mg_modBreaks = modBreaks }) = Err.withTiming dflags @@ -467,13 +467,13 @@ tidyProgram hsc_env (ModGuts { mg_module = mod cg_modBreaks = modBreaks, cg_spt_entries = spt_entries }, - ModDetails { md_types = tidy_type_env, - md_rules = tidy_rules, - md_insts = tidy_cls_insts, - md_fam_insts = fam_insts, - md_exports = exports, -